home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / ktools / source / ofile.pas < prev    next >
Pascal/Delphi Source File  |  1994-10-31  |  14KB  |  424 lines
  1. Unit OFile;
  2. { Objet fichier géré directement par appel aux fonctions DOS. }
  3. { En cas d'erreur, aucune opération ne peut plus être réalisée. }
  4. { De nombreux messages d'erreurs permettent de comprendre l'erreur. }
  5.  
  6. { Kostrzewa Bruno }
  7. { septembre 1994 }
  8.  
  9. {$IFDEF debug}
  10.  {$A+,B-,D+,E-,F-,I+,L+,N-,R+,S+,V-,W+,X+}
  11. {$ELSE}
  12.  {$A+,B-,D-,E-,F-,I+,L-,N-,R-,S-,V-,W+,X+}
  13. {$ENDIF}
  14.  
  15. INTERFACE
  16.  
  17. Uses Dos;   { pour la gestion des noms de fichier et les appels aux
  18.               interruptions }
  19.  
  20. Const
  21. { modes d'ouverture des fichiers }
  22.  stCreate     = $0001; { créer un nouveau fichier en écrasant si nécessaire
  23.                          un fichier existant }
  24.  stOpen       = $0002; { ouvrir un fichier existant }
  25.  
  26. { modes de déplacements dans le fichier }
  27.  dpDebut      = 0;
  28.  dpCourant    = 1;
  29.  dpFin        = 2;
  30.  
  31. { constante indiquant qu'aucun Handle n'est attribué au fichier }
  32.  NoHandle     = $FFFF;
  33.  
  34. Type
  35.   PFile=^TFile;
  36.   TFile=object
  37.    Handle    : Word;      { Handle du DOS }
  38.    ErrorFlag : Word;      { Numéro d'erreur DOS }
  39.    FDir      : DirStr;    { Chemin d'accès au fichier }
  40.    FName     : NameStr;   { Nom du fichier }
  41.    FExt      : ExtStr;    { Extension du fichier }
  42.    Constructor Init(Nom:String; Acces:Word);
  43.    { ouverture du fichier }
  44.    Destructor  Done;virtual;
  45.    { fermeture du fichier }
  46.    Procedure FOpen;
  47.    { ouverture d'un fichier existant }
  48.    Procedure FCreate;
  49.    { création d'un fichier }
  50.    Procedure FClose;
  51.    { fermeture du fichier }
  52.    Procedure FTruncate;
  53.    { termine le fichier à la position actuelle du pointeur }
  54.    Procedure FWriteC(Var Buf; Taille:Word; Var Res:Word);
  55.    { écriture dans le fichier avec retour du nombre d'octets écrits }
  56.    Procedure FWrite(Var Buf; Taille:Word);        virtual;
  57.    { écriture dans le fichier }
  58.    Procedure FReadC(Var Buf; Taille:Word; Var Res:Word);
  59.    { lecture dans le fichier avec retour du nombre d'octets lus }
  60.    Procedure FRead(Var Buf; Taille:Word);         virtual;
  61.    { lecture du fichier }
  62.    Procedure FSeekRel(Depl:LongInt; Mode:Byte);
  63.    { déplacement dans le fichier à partir:
  64.      du début pour Mode=dpDebut
  65.      de la position courante pour Mode=dpCourant
  66.      de la fin pour Mode=dpFin }
  67.    Procedure FSeek(Depl:LongInt);
  68.    { déplacement dans le fichier à partir du début }
  69.    Function  FSize:LongInt;
  70.    { taille du fichier sur disque }
  71.    Function  FPosit:LongInt;
  72.    { position actuelle dans le fichier }
  73.    Function  IsValid:Boolean;                     virtual;
  74.    { test d'erreur }
  75.    Function  GetErrorMsg:String;                  virtual;
  76.    { renvoie un éventuel message d'erreur }
  77.    End;
  78.  
  79. IMPLEMENTATION
  80.  
  81. Type
  82.  { pour le passage des entiers longs aux double-mots }
  83.  LongRec = record
  84.   Faible : Word;
  85.   Fort   : Word;
  86.   End;
  87.  
  88. Var Regs:Registers;
  89.  
  90. Function GetDosErrorMsg(code:Word):String;
  91. { interprétation des codes d'erreur du DOS }
  92. Begin
  93.  case code of
  94.   { 00 pas d'erreur }
  95.   $00 : GetDosErrorMsg:='';
  96.  
  97.   { 01 le numéro de la fonction ou de la sous fonction de l'interruption
  98.     n'est pas valide }
  99.   $01 : GetDosErrorMsg:='Numéro de fonction invalide.';
  100.  
  101.   { 02 le fichier cherché n'a pas été trouvé dans le répertoire spécifié }
  102.   $02 : GetDosErrorMsg:='Fichier non trouvé.';
  103.  
  104.   { 03 le répertoire spécifié n'a pas été trouvé }
  105.   $03 : GetDosErrorMsg:='Chemin non trouvé.';
  106.  
  107.   { 04 trop de fichiers ouverts car un programme ne dispose que de 20 handles }
  108.   $04 : GetDosErrorMsg:='Trop de fichiers ouverts.';
  109.  
  110.   { 05 accès au fichier refusé, par exemple pour écriture sur fichier en
  111.     lecture seule }
  112.   $05 : GetDosErrorMsg:='Accès refusé.';
  113.  
  114.   { 06 le handle spécifié ne correspond pas à un fichier ouvert }
  115.   $06 : GetDosErrorMsg:='Handle incorrect.';
  116.  
  117.   { 07 problème avec la mémoire }
  118.   $07 : GetDosErrorMsg:='Bloc de contrôle mémoire détruit.';
  119.  
  120.   { 08 mémoire insuffisante, par exemple pour exécuter un programme fils }
  121.   $08 : GetDosErrorMsg:='Mémoire insuffisante.';
  122.  
  123.   { 09 problème avec la mémoire }
  124.   $09 : GetDosErrorMsg:='Adresse de zone incorrecte.';
  125.  
  126.   { 10 mauvais environnement }
  127.   $0A : GetDosErrorMsg:='Mauvais environnement.';
  128.  
  129.   { 11 format invalide des données }
  130.   $0B : GetDosErrorMsg:='Format incorrect.';
  131.  
  132.   { 12 code d'accès incorrect, par exemple écrire dans un fichier ouvert
  133.     en lecture }
  134.   $0C : GetDosErrorMsg:='Code d''accès incorrect.';
  135.  
  136.   { 13 donnée incorrecte }
  137.   $0D : GetDosErrorMsg:='Donnée incorrecte.';
  138.  
  139.   { 14 réservé }
  140.  
  141.   { 15 mauvais numéro de lecteur }
  142.   $0F : GetDosErrorMsg:='Référence de disque incorrecte.';
  143.  
  144.   { 16 suicide interdit }
  145.   $10 : GetDosErrorMsg:='Tentative de destruction du répertoire courant.';
  146.  
  147.   { 17 périphériques différents quand on essaie de renommer }
  148.   $11 : GetDosErrorMsg:='Périphériques différents.';
  149.  
  150.   { 18 plus de fichiers lors d'une recherche }
  151.   $12 : GetDosErrorMsg:='Plus de fichiers.';
  152.  
  153.   { 19 il faut enlever la protection en écriture de la disquette ! }
  154.   $13 : GetDosErrorMsg:='Disque protégé contre l''écriture.';
  155.  
  156.   { 20 unité non reconnue par le système }
  157.   $14 : GetDosErrorMsg:='Unité inconnue.';
  158.  
  159.   { 21 introduire une disquette dans le lecteur ou fermer la porte }
  160.   $15 : GetDosErrorMsg:='Disque pas prêt.';
  161.  
  162.   { 22 problème de matériel }
  163.   $16 : GetDosErrorMsg:='Commande incorrecte.';
  164.  
  165.   { 23 problème de matériel }
  166.   $17 : GetDosErrorMsg:='Erreur de mémoire.';
  167.  
  168.   { 24 problème de matériel }
  169.   $18 : GetDosErrorMsg:='Longueur de structure incorrecte.';
  170.  
  171.   { 25 problème de matériel }
  172.   $19 : GetDosErrorMsg:='Erreur de positionnement du pointeur de fichier.';
  173.  
  174.   { 26 type de support magnétique inconnu }
  175.   $1A : GetDosErrorMsg:='Disque non formaté.';
  176.  
  177.   { 27 problème de matériel }
  178.   $1B : GetDosErrorMsg:='Secteur non trouvé.';
  179.  
  180.   { 28 erreur d'imprimante }
  181.   $1C : GetDosErrorMsg:='Plus de papier dans l''imprimante.';
  182.  
  183.   { 29 problème de matériel }
  184.   $1D : GetDosErrorMsg:='Erreur d''écriture.';
  185.  
  186.   { 30 problème de matériel }
  187.   $1E : GetDosErrorMsg:='Erreur de lecture.';
  188.  
  189.   { 31 problème matériel }
  190.   $1F : GetDosErrorMsg:='Erreur liée au matériel.';
  191.   else  GetDosErrorMsg:='Erreur non répertoriée.'
  192.   end;
  193. End;
  194.  
  195. { Objet TFile }
  196.  
  197. Constructor TFile.Init(Nom:String; Acces:Word);
  198. Var P : PathStr;
  199.     i : Integer;
  200.     S : SearchRec;
  201. Begin
  202.  ErrorFlag:=0;
  203.  Handle:=NoHandle;
  204.  { retrouver le nom complet et le mettre en majuscules }
  205.  P:=FExpand(Nom);
  206.  for i:=1 to length(P) do P[i]:=UpCase(P[i]);
  207.  { conserver les parties séparées }
  208.  FSplit(P,FDir,FName,FExt);
  209.  { ouverture du fichier }
  210.  case Acces of
  211.     stCreate : FCreate;
  212.     stOpen   : FOpen;
  213.     end;
  214. End;
  215.  
  216. Destructor TFile.Done;
  217. { on ferme le fichier }
  218. Begin
  219.  FClose;
  220. End;
  221.  
  222. Procedure TFile.FOpen;
  223. Var P : PathStr;
  224. Begin
  225.  if Handle<>NoHandle  { fichier déjà ouvert }
  226.     then begin
  227.           FClose;
  228.           if not IsValid then exit;
  229.          end;
  230.  P:=FDir+FName+FExt+#0;          { Chaîne à 0 terminal pour DOS      }
  231.  Regs.AH:=$3D;                   { Ouvrir fichier existant           }
  232.  Regs.AL:=2;                     { Mode d'accès : Lit/Ecrit          }
  233.  Regs.DS:=Seg(P[1]);             { Adresse du nom ASCII-Z            }
  234.  Regs.DX:=Ofs(P[1]);
  235.  Intr($21,Regs);                 { Invoque le DOS                    }
  236.  if (Regs.Flags and FCarry)<>0   { Test d'erreur DOS                 }
  237.     then ErrorFlag:=Regs.AX
  238.     else Handle:=Regs.AX;        { Recupère le Handle du fichier     }
  239. End;
  240.  
  241. Procedure TFile.FCreate;
  242. Var P : PathStr;
  243. Begin
  244.  if Handle<>NoHandle  { fichier déjà ouvert }
  245.     then begin
  246.           FClose;
  247.           if not IsValid then exit;
  248.          end;
  249.  P:=FDir+FName+FExt+#0;
  250.  Regs.AH:=$3C;                   { Créer ou vider fichier            }
  251.  Regs.CX:=0;                     { Attribut fichier : fichier normal }
  252.  Regs.DS:=Seg(P[1]);             { Adresse du nom ASCII-Z            }
  253.  Regs.DX:=Ofs(P[1]);
  254.  Intr($21,Regs);                 { Invoque le DOS                    }
  255.  if (Regs.Flags and FCarry)<>0   { Test d'erreur DOS                 }
  256.     then ErrorFlag:=Regs.AX
  257.     else Handle:=Regs.AX;        { Recupère le Handle du fichier     }
  258. End;
  259.  
  260. Procedure TFile.FClose;
  261. Begin
  262.  if Handle=NoHandle then exit;   { Fichier déjà fermé                 }
  263.  Regs.AH:=$3E;                   { Fonction : fermer le fichier       }
  264.  Regs.BX:=Handle;                { Donne le Handle du fichier         }
  265.  Intr($21,Regs);                 { Invoque le DOS                     }
  266.  if (Regs.Flags and FCarry)<>0   { Test d'erreur                      }
  267.     then ErrorFlag:=Regs.AX;
  268.  Handle:=NoHandle;               { Plus de handle pour le fichier     }
  269. End;
  270.  
  271. Procedure TFile.FTruncate;
  272. Begin
  273.  if (ErrorFlag<>0) then Exit;
  274.  Regs.AH:=$40;                         { Ecrire dans fichier               }
  275.  Regs.BX:=Handle;                      { Donne le Handle du fichier        }
  276.  Regs.CX:=0;                           { Ecrire 0 octet=truncate           }
  277.  Intr($21,Regs);                       { Invoque le DOS                    }
  278.  If (Regs.Flags and FCarry)<>0         { Test d'erreur DOS                 }
  279.     then ErrorFlag:=Regs.AX;
  280. End;
  281.  
  282. Procedure TFile.FWriteC(Var Buf; Taille:Word; Var Res:Word);
  283. { écriture avec récupération du nombre d'octets écrits dans Res }
  284. Begin
  285.  if (ErrorFlag<>0) or (Taille=0) then Exit;
  286.  Regs.AH:=$40;                         { Ecrire dans fichier               }
  287.  Regs.BX:=Handle;                      { Donne le Handle du fichier        }
  288.  Regs.CX:=Taille;                      { Nombre d'octets à écrire          }
  289.  Regs.DS:=Seg(Buf);                    { Adresse de la destination         }
  290.  Regs.DX:=Ofs(Buf);
  291.  Intr($21,Regs);                       { Invoque le DOS                    }
  292.  Res:=Regs.AX;                         { Nombre d'octets écrits            }
  293.  If (Regs.Flags and FCarry)<>0         { Test d'erreur DOS                 }
  294.     then ErrorFlag:=Regs.AX;
  295. End;
  296.  
  297. Procedure TFile.FWrite(Var Buf; Taille:Word);
  298. { écriture simple }
  299. Begin
  300.  if ErrorFlag<>0  then Exit;
  301.  Regs.AH:=$40;                         { Ecrire dans fichier               }
  302.  Regs.BX:=Handle;                      { Donne le Handle du fichier        }
  303.  Regs.CX:=Taille;                      { Nombre d'octets à écrire          }
  304.  Regs.DS:=Seg(Buf);                    { Adresse de la destination         }
  305.  Regs.DX:=Ofs(Buf);
  306.  Intr($21,Regs);                       { Invoque le DOS                    }
  307.  If (Regs.Flags and FCarry)<>0         { Test d'erreur DOS                 }
  308.     then ErrorFlag:=Regs.AX;
  309. End;
  310.  
  311. Procedure TFile.FReadC(Var Buf; Taille:Word; Var Res:Word);
  312. { lecture avec récupération du nombre d'octets lus }
  313. Begin
  314.  if ErrorFlag<>0 then exit;
  315.  Regs.AH:=$3F;                         { Lire le fichier                   }
  316.  Regs.BX:=Handle;                      { Donne la Handle du fichier        }
  317.  Regs.CX:=Taille;                      { Nombre d'octets à lire            }
  318.  Regs.DS:=Seg(Buf);                    { Adresse de la destination         }
  319.  Regs.DX:=Ofs(Buf);
  320.  Intr($21,Regs);                       { Invoque le DOS                    }
  321.  Res:=Regs.AX;                         { Nombre d'octets lus               }
  322.  if (Regs.Flags and FCarry)<>0         { Test d'erreur DOS                 }
  323.     then ErrorFlag:=Regs.AX;
  324. End;
  325.  
  326. Procedure TFile.FRead(Var Buf; Taille:Word);
  327. { lecture simple }
  328. Begin
  329.  if ErrorFlag<>0 then exit;
  330.  Regs.AH:=$3F;                         { Lire le fichier                   }
  331.  Regs.BX:=Handle;                      { Donne le Handle du fichier        }
  332.  Regs.CX:=Taille;                      { Nombre d'octets à lire            }
  333.  Regs.DS:=Seg(Buf);                    { Adresse de la destination         }
  334.  Regs.DX:=Ofs(Buf);
  335.  Intr($21,Regs);                       { Invoque le DOS                    }
  336.  if (Regs.Flags and FCarry)<>0         { Test d'erreur DOS                 }
  337.     then ErrorFlag:=Regs.AX;
  338. End;
  339.  
  340. Procedure TFile.FSeekRel(Depl:LongInt; Mode:Byte);
  341. { déplacement relatif du pointeur }
  342. Begin
  343.  if ErrorFlag<>0 then Exit;
  344.  Regs.AH:=$42;                         { Déplacement du pointeur           }
  345.  Regs.AL:=Mode;                        { Mode de calcul du déplacement     }
  346.  Regs.BX:=Handle;                      { Donne le handle du fichier        }
  347.  Regs.CX:=LongRec(Depl).Fort;          { Valeur du déplacement             }
  348.  Regs.DX:=LongRec(Depl).Faible;
  349.  Intr($21,Regs);                       { Invoque le DOS                    }
  350.  if (Regs.Flags and FCarry)<>0         { Test d'erreur DOS                 }
  351.     then ErrorFlag:=Regs.AX;
  352. End;
  353.  
  354. Procedure TFile.FSeek(Depl:LongInt);
  355. { positionnement à partir du début }
  356. Begin
  357.  FSeekRel(Depl, dpDebut);
  358. End;
  359.  
  360. Function TFile.FSize:LongInt;
  361. { calcul de la taille du fichier }
  362. Var t,l:LongInt;
  363. Begin
  364.  FSize:=0;          { réponse par défaut }
  365.  if ErrorFlag<>0  then Exit;
  366.  t:=FPosit;         { mémorise la position courante du pointeur }
  367.  if ErrorFlag<>0  then Exit;
  368.  { se positionner en fin de fichier }
  369.  Regs.AH:=$42;
  370.  Regs.AL:=dpFin;
  371.  Regs.BX:=Handle;
  372.  Regs.CX:=0;
  373.  Regs.DX:=0;
  374.  Intr($21,Regs);
  375.  { lire la position à partir du début }
  376.  LongRec(l).Fort:=Regs.DX;
  377.  LongRec(l).Faible:=Regs.AX;
  378.  { test d'erreur DOS }
  379.  if (Regs.Flags and FCarry)<>0
  380.     then ErrorFlag:=Regs.AX
  381.     else begin
  382.           FSize:=l;
  383.           { rétablir la position initiale }
  384.           FSeekRel(t,dpDebut);
  385.          end;
  386. End;
  387.  
  388. Function TFile.FPosit:LongInt;
  389. Var l:LongInt;
  390. Begin
  391.  FPosit:=-1;     { réponse par défaut }
  392.  if ErrorFlag<>0 then exit;
  393.  { se positionner à la position courante }
  394.  Regs.AH:=$42;
  395.  Regs.AL:=dpCourant;
  396.  Regs.BX:=Handle;
  397.  Regs.CX:=0;
  398.  Regs.DX:=0;
  399.  Intr($21,Regs);
  400.  { lire la position à partir du début }
  401.  LongRec(l).Fort:=Regs.DX;
  402.  LongRec(l).Faible:=Regs.AX;
  403.  { test d'erreur DOS }
  404.  If (Regs.Flags and FCarry)<>0
  405.     then ErrorFlag:=Regs.AX
  406.     else FPosit:=l;
  407. End;
  408.  
  409. Function TFile.IsValid:Boolean;
  410. Begin
  411.  IsValid:=ErrorFlag=0;
  412. End;
  413.  
  414. Function TFile.GetErrorMsg:String;
  415. Begin
  416.  if ErrorFlag<>0
  417.     then GetErrorMsg:=FName+FExt+' : '+GetDosErrorMsg(ErrorFlag)
  418.     else GetErrorMsg:='';
  419. End;
  420.  
  421. END.
  422.  
  423. {                          Fin du fichier OFile.Pas                         }
  424.