home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / ktools / source / ofswag.pas < prev    next >
Pascal/Delphi Source File  |  1994-11-02  |  9KB  |  317 lines
  1. Unit OFSwag;
  2. { Objet Fichier SWAG, dérivé de l'objet TBinFile }
  3. { K.B. mai-novembre 1994 }
  4.  
  5. Interface
  6.  
  7. Uses Dos,OBinFile,OTableau;
  8.  
  9.  { Un fichier Swag est organisé en blocks de 128 octets.
  10.    Le premier block contient des informations générales. }
  11.  
  12. Const
  13.  erFormat = $102;
  14.  
  15.  { Entête du fichier }
  16.  ControlHdr:array[1..11] of String[30]=(
  17.  {1} 'SOURCEWARE ARCHIVAL GROUP',
  18.  {2} 'Goshen',
  19.  {3} '875-8133',
  20.  {4} 'Gayle Davis',
  21.  {5} '99999,SWAG',
  22.  {6} '11-03-1993,04:41:37',
  23.  {7} 'SWAG Genius',
  24.  {8} '',     { QMAIL Menu name ???                 }
  25.  {9} '0',    { allways ZERO ???                    }
  26. {10} '0',    { total number of messages in package }
  27. {11} '56');  { number of conferences-1 here        }
  28.              { next is 0 , then first conference   }
  29.  
  30.  { A partir du second block on trouve les messages contenus dans
  31.    le fichier. Chaque message commence par un bloc entête, puis
  32.    est formé par un nombre variable de blocks qui constituent
  33.    le corps du message. Celui-ci est écrit en ASCII avec toutefois
  34.    une particularité : les retours à la ligne sont marqués par
  35.    le symbole π. La fin d'un message est marquée par un symbole
  36.    de fin de fichier texte (#26) }
  37.  { L'objet TSwagFile aura pour fonction de recenser les messages
  38.    contenus dans le fichier, puis de créer des tableaux de chaines
  39.    de caractères permettant la lecture, la sauvegarde ou
  40.    l'impression des messages. }
  41.  { Le recensement se fera dans un tableau d'enregistrements qui
  42.    conserveront le numéro de block du début du message et des
  43.    renseignements susceptibles d'identifier le message. }
  44.  
  45. Type
  46.  { Entête de message }
  47.  PSwagMsgHeader=^TSwagMsgHeader;
  48.  TSwagMsgHeader = record
  49.   Status   : Char;
  50.    { Statut du message :
  51.    ' ' = public, unread
  52.    '-' = public, read
  53.    '+' = private, unread
  54.    '*' = private, read
  55.    '~' = comment to Sysop, unread
  56.    '`' = comment to Sysop, read
  57.    '%' = password protected, unread
  58.    '^' = password protected, read
  59.    '!' = group password, unread
  60.    '#' = group password, read
  61.    '$' = group password to all }
  62.   MSGNum   : array [1..7] OF Char;
  63.   { Numéro du message (en ASCII) }
  64.   Date     : array [1..8] OF Char;
  65.   { Date (mm-jj-aa, en ASCII) }
  66.   Time     : array [1..5] OF Char;
  67.   { Heure (24 heures hh:mm, en ASCII) }
  68.   UpTO     : array [1..25] OF Char;
  69.   { Destinataire (majuscules, justifié à gauche) }
  70.   UpFROM   : array [1..25] OF Char;
  71.   { Auteur (majuscules, justifié à gauche) }
  72.   Subject  : array [1..25] OF Char;
  73.   { Sujet du message }
  74.   PassWord : array [1..12] OF Char;
  75.   { Mot de passe (rempli d'espaces) }
  76.   ReferNum : array [1..8] OF Char;
  77.   { Numéro de référence du message (en ASCII) }
  78.   NumChunk : array[1..6] of Char;
  79.   { Nombre de blocks de 128 octets dans le message (en incluant
  80.     l'entête, en ASCII; la valeur minimale est 2, pour l'entête
  81.     et un block message.}
  82.   Alive    : Char;
  83.   { #225 = actif, #226 = à détruire }
  84.   ConfNum  : Word;
  85.   { Numéro de la conférence }
  86.   Reserved : array [1..3] OF Char;
  87.   { Pas utilisé, remplir de #0 ou d'espaces}
  88.   end;
  89.  
  90.  { Record utilisé pour recenser les messages contenus dans un fichier. }
  91.  TMsgRec=record
  92.   Sujet:String[25];
  93.   Posit:LongInt;
  94.   end;
  95.  
  96.  { Objet fichier Swag, dérivé de TBinFile }
  97.  PSwagFile=^TSwagFile;
  98.  TSwagFile=object(TBinFile)
  99.   MsgTab:TTableau;            { tableau recensant les messages }
  100.   Constructor Init(NomDeFichier:PathStr);
  101.   { appelle le constructeur de TBinFile, puis construit le tableau
  102.     des entêtes de messages }
  103.   Destructor Done; virtual;
  104.   { ferme le fichier et libère la mémoire }
  105.   Function GetErrorMsg:String;virtual;
  106.   { renvoie un message d'erreur }
  107.   { ErrorFlag=2 donne 'Format de fichier incorrect.' }
  108.   Procedure MakeTab;
  109.   { construction du tableau des entêtes des messages }
  110.   Function ReadMsg(N:Integer):PStrTab;
  111.   { lecture du message numéro N et conversion en tableau de chaines
  112.     de caractères }
  113.   Procedure ReadMsgHeader(Var MH:TSwagMsgHeader;N:Integer);
  114.   { lecture de l'entête du message numéro N }
  115.   end;
  116.  
  117. { type utilisé par les fonctions de lecture d'entête de message }
  118.  TStr25=String[25];
  119.  
  120. { fonctions de lecture de l'entête d'un message }
  121.  
  122. Function LongueurMsg(M:TSwagMsgHeader):LongInt;
  123. { renvoie la longueur d'un message, entête compris, en blocks de 128
  124.   caractères }
  125.  
  126. Function AuteurMsg(M:TSwagMsgHeader):TStr25;
  127. { renvoie le nom de l'auteur du message }
  128.  
  129. Function DestMsg(M:TSwagMsgHeader):TStr25;
  130. { renvoie le destinataire du message }
  131.  
  132. Function SujetMsg(M:TSwagMsgHeader):TStr25;
  133. { renvoie le sujet du message }
  134.  
  135. Function DateMsg(M:TSwagMsgHeader):TStr25;
  136. { renvoie la date du message }
  137.  
  138. Implementation
  139.  
  140. Function LongueurMsg(M:TSwagMsgHeader):LongInt;
  141. { renvoie la longueur d'un message, entête compris, en blocks de 128
  142.   caractères }
  143. Var i:Byte;
  144.     S:String[6];
  145.     Err:Word;
  146.     Temp:LongInt;
  147. Begin
  148.  S:='';
  149.  for i:=1 to 6 do
  150.   if M.NumChunk[i]<>#32
  151.      then S:=S+M.NumChunk[i];
  152.  val(S,Temp,Err);
  153.  if Err=0
  154.     then LongueurMsg:=Temp
  155.     else LongueurMsg:=0;
  156. End;
  157.  
  158. Function AuteurMsg(M:TSwagMsgHeader):TStr25;
  159. { renvoie le nom de l'auteur du message }
  160. Var S:TStr25;
  161. Begin
  162.  move(M.UpFrom,S[1],25);
  163.  S[0]:=#25;
  164.  AuteurMsg:=S;
  165. End;
  166.  
  167. Function DestMsg(M:TSwagMsgHeader):TStr25;
  168. { renvoie le destinataire du message }
  169. Var S:TStr25;
  170. Begin
  171.  move(M.UpTo,S[1],25);
  172.  S[0]:=#25;
  173.  DestMsg:=S;
  174. End;
  175.  
  176. Function SujetMsg(M:TSwagMsgHeader):TStr25;
  177. { renvoie le sujet du message }
  178. Var S:TStr25;
  179. Begin
  180.  move(M.Subject,S[1],25);
  181.  S[0]:=#25;
  182.  SujetMsg:=S;
  183. End;
  184.  
  185. Function DateMsg(M:TSwagMsgHeader):TStr25;
  186. { renvoie la date du message }
  187. Begin
  188.  with M do
  189.    DateMsg:=Date[4]+Date[5]+'/'+Date[1]+Date[2]+'/'+Date[7]+Date[8];
  190. End;
  191.  
  192. { objet TSwagFile }
  193.  
  194. Constructor TSwagFile.Init(NomDeFichier:PathStr);
  195. Begin
  196.  { constructeur hérité avec buffer de 16 Ko }
  197.  TBinFile.Init(NomDeFichier,16*1024);
  198.  { attribution de mémoire }
  199.  MsgTab.Init(20,20,sizeof(TMsgRec));
  200.  if not MsgTab.IsValid
  201.     then ErrorFlag:=1;
  202.  if IsValid       { tout s'est bien passé }
  203.     then MakeTab; { construction du tableau des messages }
  204. End;
  205.  
  206. Destructor TSwagFile.Done;
  207. Begin
  208.  MsgTab.Done;
  209.  TBinFile.Done;
  210. End;
  211.  
  212. Procedure TSwagFile.MakeTab;
  213. { construction du tableau des messages }
  214. Var MR:TMsgRec;
  215.     HR:TSwagMsgHeader; { entête du message }
  216.     L:LongInt;
  217. Begin
  218.  { le premier message est le block 1, 2ème block du fichier }
  219.  MR.Posit:=1;
  220.  repeat
  221.   { lire l'entête }
  222.   SetFilePosit(MR.Posit*128);
  223.   ReadVar(HR,sizeof(HR));
  224.   { récupérer le sujet }
  225.   MR.Sujet:=SujetMsg(HR);
  226.   { recenser dans le tableau }
  227.   MsgTab.Ajouter(MR);
  228.   { pointer sur le début du message suivant }
  229.   L:=LongueurMsg(HR);
  230.   if L<2
  231.      then begin
  232.            ErrorFlag:=erFormat;
  233.            exit;
  234.           end;
  235.   MR.Posit:=MR.Posit+L;
  236.  until MR.Posit*128>=DataFileSize;
  237. End;
  238.  
  239. Function TSwagFile.GetErrorMsg:String;
  240. Begin
  241.  if ErrorFlag=erFormat
  242.     then GetErrorMsg:='Format de fichier incorrect.'
  243.     else GetErrorMsg:=TBinFile.GetErrorMsg;
  244. End;
  245.  
  246. Procedure TSwagFile.ReadMsgHeader(Var MH:TSwagMsgHeader;N:Integer);
  247. { Lecture de l'entête du message N }
  248. Var MR:TMsgRec;
  249. Begin
  250.  if (N<1) or (N>MsgTab.NombreItems)
  251.     then exit;
  252.  MsgTab.Lire(MR,N);
  253.  SetFilePosit(MR.Posit*128);
  254.  ReadVar(MH,sizeof(MH));
  255. End;
  256.  
  257. Function TSwagFile.ReadMsg(N:Integer):PStrTab;
  258. { Lecture du message numéro N.}
  259. Var p,q:Byte;       { position des caractères spéciaux dans S }
  260.     curpos:LongInt; { position dans le fichier }
  261.     S:String;       { chaine pour utiliser la fonction Pos }
  262.     Res:PStrTab;    { tableau de chaines créé }
  263.     MR:TMsgRec;     { recensement }
  264.     fini:Boolean;   { indicateur de fin }
  265. Begin
  266.  if (N<1) or (N>MsgTab.NombreItems)
  267.     then begin
  268.           ReadMsg:=nil;
  269.           exit;
  270.          end;
  271.  fini:=false;
  272.  { détruire l'ancien contenu }
  273.  Res:=new(PStrTab,Init(100,50));
  274.  if not Res^.IsValid
  275.     then begin
  276.           ErrorFlag:=1;
  277.           dispose(Res,Done);
  278.           ReadMsg:=nil;
  279.           exit;
  280.          end;
  281.  { lire le tableau de recensement et la position dans le fichier }
  282.  MsgTab.Lire(MR,N);
  283.  curpos:=(MR.Posit+1)*128;
  284.  repeat
  285.   { on lit le contenu du fichier dans S }
  286.   SetFilePosit(curpos);
  287.   S[0]:=chr(255);
  288.   ReadVar(S[1],255);
  289.   { on cherche le symbole de fin de ligne π }
  290.   p:=pos('π',S);
  291.   if p<>0
  292.      then begin  { symbole π trouvé }
  293.            S[0]:=chr(p-1);   { limiter la longueur de la chaine }
  294.            q:=pos(chr(26),S);      { chercher le symbole de fin }
  295.            if q<>0
  296.               then begin         { symbole de fin trouvé }
  297.                     S[0]:=chr(q-1);  { couper de nouveau }
  298.                     fini:=true;         { fin du travail }
  299.                    end;
  300.             Res^.AjouterLigne(S);      { recenser la ligne }
  301.             curpos:=curpos+p;          { nouvelle position dans le fichier }
  302.            end
  303.      else begin  { symbole π absent }
  304.            fini:=true;        { fin du travail }
  305.            q:=pos(chr(26),S); { chercher le symbole de fin }
  306.            if q<>0
  307.               then S[0]:=chr(q-1);    { couper la ligne }
  308.             Res^.AjouterLigne(S);     { recenser la dernière ligne }
  309.           end;
  310.  until fini;
  311.  ReadMsg:=Res;
  312. End;
  313.  
  314. END.
  315.  
  316. {                          Fin du fichier OFSWAG.PAS                        }
  317.