home *** CD-ROM | disk | FTP | other *** search
/ Fifty: Elektronik / FIFTY Elektronik (PS_Computer_Vertrieb).iso / ps8 / fty1017 / gepackt.exe / DISK2 / PLOTSRC.EXE / LIBFILE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-10  |  7.8 KB  |  287 lines
  1. {$I-,O+}
  2. Unit LibFile;
  3.  
  4. Interface
  5.  
  6. Uses  Dos,StrTool,GEDDEFS,LIBACCES;
  7.  
  8. Function Insert_in_Dir(Var Eintrag:Dir_Entry;Var Verz:Dir_Table):Word;
  9.   { 0 , wenn DIR voll, sonst INDEX des Eintrags }
  10.  
  11. Function Remove_From_Dir(Var Eintrag:Dir_Entry;Var Verz:Dir_Table):Word;
  12.   { 0 , wenn nicht gefunden , sonst Index des entfernten Eintrags }
  13.  
  14. Function Init_Lib(Libfile:PathStr):Boolean;
  15. { True, wenn Ok, schließ Datei wieder }
  16.  
  17. Function Packen_Empfohlen(Var DIR:Dir_Table):Boolean;
  18.  
  19. Function Packe_LIB(Var LibFile :PathStr;Var Verz:Dir_Buffer):Boolean;
  20.  
  21. Function Append_Macro(LibFile,Macro:PathStr;SymName:NameStr):Word;
  22.   { 0 :Ok, Sonst Fehler
  23.     1 : Fehler bei Directory-Zugriff oder LIBFile nicht gefunden or Wrong File-Version
  24.     2 : Fehler bei Schreiben
  25.     4 : Fehler beim lesen des Macros
  26.     6 : Fehler beim lesen wie beim Schreiben
  27.     8 : Fehler beim Packen}
  28.  
  29. Function Append_Macro_uni(Source,Dest:PathStr;SymName:NameStr;
  30.                           FileDate,Offset:Longint;Count:Word):Word;
  31.  
  32. implementation
  33.  
  34.  
  35. Function Insert_in_Dir(Var Eintrag:Dir_Entry;Var Verz:Dir_Table):Word;
  36. Var Ins_Idx:Word;
  37. begin
  38.    Insert_In_Dir:=0;
  39.    UpStr(Eintrag.MacroName);
  40.    Ins_Idx:=Find_In_Dir(Eintrag.MacroName,Verz);
  41.    If Ins_Idx >0 then
  42.      begin
  43.         With Verz[0] do
  44.         begin
  45.           Inc(UsedBLDRecs,Eintrag.NrofRecs);
  46.           Dec(UsedBLDRecs,Verz[Ins_Idx].NrofRecs);
  47.           Inc(TotalSize,Eintrag.NrofRecs);
  48.         end;
  49.         Verz[Ins_idx]:=Eintrag;
  50.      end
  51.    else
  52.      begin
  53.        If Verz[0].NrofDirEntries>=Max_Lib_Size then Exit;
  54.        Ins_Idx:=1;
  55.        While (Ins_Idx<=Verz[0].NrofDirEntries) and
  56.              (Eintrag.MacroName>Verz[Ins_Idx].Macroname) Do Inc(Ins_idx);
  57.        Inc(Verz[0].NrOfDirEntries);
  58.        Move(Verz[Ins_Idx],Verz[Ins_Idx+1],(Verz[0].NrofDirEntries-Ins_Idx) *Sizeof(Dir_Entry));
  59.        Verz[Ins_Idx]:=Eintrag;
  60.        With Verz[0] do
  61.         begin
  62.           Inc(UsedBLDRecs,Eintrag.NrofRecs);
  63.           Inc(TotalSize,Eintrag.NrofRecs);
  64.         end;
  65.      end;
  66.    Insert_In_Dir:=Ins_Idx;
  67. end;
  68.  
  69. Function Remove_From_Dir(Var Eintrag:Dir_Entry;Var Verz:Dir_Table):Word;
  70. Var Ins_Idx:Word;
  71. begin
  72.    Remove_From_Dir:=0;
  73.    UpStr(Eintrag.MacroName);
  74.    Ins_Idx:=Find_In_Dir(Eintrag.MacroName,Verz);
  75.    If Ins_Idx >0 then
  76.      begin
  77.        Dec(Verz[0].UsedBLDRecs,Verz[Ins_Idx].NrOfRecs);
  78.        Move(Verz[Ins_Idx+1],Verz[Ins_Idx],(Verz[0].NrofDirEntries-Ins_Idx) *Sizeof(Dir_Entry));
  79.        FillChar(Verz[Verz[0].NrofDirEntries],Sizeof(Dir_Entry),0);
  80.        Dec(Verz[0].NrofDirEntries);
  81.        Remove_From_Dir:=Ins_Idx;
  82.      end;
  83. end;
  84.  
  85. Function Init_Lib(Libfile:PathStr):Boolean;
  86. Var LibF :File;
  87.     Verz :Dir_Buffer;
  88. begin
  89.   Init_Lib:=false;
  90.   Inc(No_Blink);
  91.   Assign(LibF,LibFile);
  92.   Rewrite(LibF,Sizeof(Bildelement));
  93.   Dec(No_Blink);
  94.   If Ioresult<>0 then begin CloseF(LibF);Exit; end;
  95.   Fillchar(Verz,Sizeof(Verz),0);
  96.   With Verz.DIR[0] Do FILEID:=LIB_FILEID;
  97.   If NOT PUT_DIR_BUFF(LIBF,Verz) then Exit;
  98.   CloseF(LibF);
  99.   Init_Lib:=True;
  100. end;
  101.  
  102. Function Packen_Empfohlen(Var DIR:Dir_Table):Boolean;
  103. Const Slack = 1.5;
  104. begin
  105.   With DIR[0] do
  106.   Packen_Empfohlen:=(TotalSize>1000) and (Round(UsedBLDRecs*Slack)<TotalSize);
  107. end;
  108.  
  109. Function _Packe_LIB(Var LibFile :PathStr;Var Verz:Dir_Buffer):Boolean;
  110. Var Infile,TempFile:File;
  111.     TempName:PathStr;
  112.     P_Orig  :PathStr;
  113.     N_Orig  :NameStr;
  114.     E_Orig  :ExtStr;
  115.     BLD     :Bildelement;
  116.     Dummy,
  117.     I,J     :Word;
  118.  
  119.  Procedure Quit;
  120.  begin
  121.    CloseF(Infile);
  122.    CloseF(TempFile);
  123.    Erase(Tempfile);
  124.    If Ioresult=0 then Exit;
  125.  end;
  126.  
  127.  Function Error:Boolean;
  128.  begin
  129.    Error:=False;
  130.    If Ioresult=0 then  Exit;
  131.    Error:=True;
  132.    Quit;
  133.  end;
  134.  
  135. begin
  136.   _Packe_Lib:=false;
  137.   Fsplit(LibFile,P_Orig,N_Orig,E_Orig);
  138.   TempName:=RandomFileName(P_Orig,'.LIB');
  139.   Assign(Infile,LibFile);
  140.   If Not(Get_Dir_Buff(InFile,Verz)) then Exit;
  141.   If Not Init_Lib(TempName) then Exit;
  142.   Assign(TempFile,TempName);
  143.   Reset(TempFile,Sizeof(Bildelement));
  144.   If Error then Exit;
  145.   Seek(TempFile,FileSize(TempFile));
  146.   If Error then Exit;
  147.   Verz.Dir[0].UsedBLDRecs:=0;
  148.   For I:= 1 to Verz.DIR[0].NrOfDirEntries Do
  149.     With Verz.DIR[I] do
  150.       begin
  151.         Seek(Infile,FileOffset);
  152.         If Error then Exit;
  153.         FileOffset:=FileSize(TempFile);
  154.         If Error then Exit;
  155.         Inc(Verz.Dir[0].UsedBLDRecs,NrofRecs);
  156.         For J:= 1 to NrOfRecs Do
  157.           begin
  158.             BlockRead(Infile,Bld,1);
  159.             If Error then Exit;
  160.             BlockWrite(TempFile,Bld,1);
  161.             If Error then Exit;
  162.           end;
  163.       end;
  164.   Verz.Dir[0].TotalSize:=Verz.Dir[0].UsedBLDRecs;
  165.   If Not Put_Dir_Buff(TempFile,Verz) then begin Quit; Exit end;
  166.   CloseF(InFile);
  167.   Rename(Infile,RandomFilename(P_Orig,'.LI$'));
  168.   Dummy:=IoResult;
  169.   CloseF(TempFile);
  170.   Rename(TempFile,P_Orig+N_Orig+E_Orig);
  171.   If Ioresult=0 then
  172.    begin
  173.      Erase(Infile);
  174.      Dummy:=IOresult;
  175.    end
  176.   else
  177.    begin
  178.      Rename(Infile,P_Orig+N_Orig+E_Orig);
  179.      Dummy:=Ioresult;
  180.      Erase(TempFile);
  181.      Dummy:=Ioresult;
  182.      Exit;
  183.    end;
  184.    _Packe_Lib:=True;
  185. end;
  186.  
  187. Function Packe_LIB(Var LibFile :PathStr;Var Verz:Dir_Buffer):Boolean;
  188. begin
  189.   Inc(No_blink);
  190.   Packe_LIB:=_Packe_LIB(LibFile,Verz);
  191.   Dec(No_Blink);
  192. end;
  193.  
  194. Function Append_Macro_LIB(Var LibFile,Macro:PathStr;Var SymName:NameStr;
  195.                           Date,Offset:Longint;Count:Word):Word;
  196. Var LibF,MacFile :File;
  197.     Verz :Dir_Buffer;
  198.     P    :PathStr;
  199.     N    :NameStr;
  200.     E    :ExtStr;
  201.     WritePos:Longint;
  202.     Eintrag :Dir_Entry;
  203.     Ok_In:Boolean;
  204.     Ok_out:Boolean;
  205.     Dummy :Word;
  206.     BLD   :Bildelement;
  207.     Nr    :Word;
  208.     SrcVers:Word;
  209.  
  210. begin
  211.   Append_Macro_LIB:=1;
  212.   Assign(LibF,LibFile);
  213.   If Not(Get_Dir_Buff(LibF,Verz)) then Exit;
  214.   WritePos:=Filesize(LibF);
  215.   Fillchar(Eintrag,Sizeof(Eintrag),0);
  216.   Eintrag.FileOffset:=WritePos;
  217.   Seek(LibF,WritePos);
  218.   Ok_Out:=Ioresult=0;
  219.   If Ok_Out then
  220.   begin
  221.     Assign(MacFile,Macro);
  222.     Reset(MacFile,Sizeof(Bildelement));
  223.     Ok_In:=Ioresult=0;
  224.     Seek(Macfile,Offset);
  225.     Ok_In:=Ok_In and (Ioresult=0);
  226.     Eintrag.NrOfRecs:=0;
  227.     While Ok_In and Ok_Out
  228.           and Not(Eof(Macfile))
  229.           and (Eintrag.NrofRecs<Count)   do
  230.       begin
  231.         BlockRead(MacFile,BLD,1);
  232.         Ok_In:=Ioresult=0;
  233.         If Eintrag.NrOfRecs=0 then
  234.          begin
  235.            SrcVers:=Defaults(BLD).GEDVersion;
  236.            FitVersionCode(SrcVers);
  237.            Defaults(BLD).GEDVersion:=VersionCode;
  238.          end else Update_Obj(BLD,SrcVers);
  239.         If Ok_In then
  240.          begin
  241.            BlockWrite(LibF,BLD,1);
  242.            Ok_Out:=Ioresult=0;
  243.            Inc(Eintrag.NrOfRecs);
  244.          end;
  245.       end;
  246.     If Date<>0 then
  247.       Eintrag.Date:=Date
  248.     else
  249.       GetFTime(MacFile,Eintrag.Date);
  250.     Close(MacFile);
  251.     Dummy:=Ioresult;
  252.     If SymName='' then
  253.        Fsplit(Macro,P,Eintrag.MacroName,E)
  254.     else
  255.       Eintrag.MacroName:=SymName;
  256.     If Ok_In and Ok_Out then
  257.       If Insert_In_Dir(Eintrag,Verz.DIR)>0 then
  258.         Ok_Out:=Put_Dir_Buff(LibF,Verz);
  259.   end;
  260.   Close(LibF);
  261.   Ok_Out:=Ok_Out and (Ioresult=0);
  262.   Append_Macro_LIB:=0;
  263.   If Not(Ok_Out) then Append_Macro_LIB:=2;
  264.   If Not(Ok_In) then Append_Macro_LIB:=4;
  265.   If Not(Ok_In or Ok_Out) then Append_Macro_LIB:=6;
  266.   If Ok_In and Ok_Out and Packen_Empfohlen(Verz.DIR) then
  267.     If Not Packe_LIB(Libfile,Verz) then Append_Macro_LIB:=8;
  268. end;
  269.  
  270. Function Append_Macro(LibFile,Macro:PathStr;SymName:NameStr):Word;
  271. begin
  272.   Inc(No_blink);
  273.   Append_Macro:=Append_Macro_LIB(LibFile,Macro,SymName,0,0,$FFFF);
  274.   Dec(No_blink);
  275. end;
  276.  
  277. Function Append_Macro_uni(Source,Dest:PathStr;SymName:NameStr;
  278.                           FileDate,Offset:Longint;Count:Word):Word;
  279. begin
  280.   Inc(No_blink);
  281.   Append_Macro_uni:=Append_Macro_LIB(Dest,Source,SymName,FileDate,Offset,Count);
  282.   Dec(No_blink);
  283. end;
  284.  
  285.  
  286. end.
  287.