home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / filutl / ldiff12s.arc / LDREPL.PAS < prev    next >
Pascal/Delphi Source File  |  1989-07-15  |  3KB  |  129 lines
  1. (*---------------------------------------------------------------------------*)
  2. (*LDRepl.pas ùΓôÇÅêù¥               (C) ÄOû╪ÿaòF NIFTY SDR SDI00147 1989/7/1 *)
  3. (*$B-,F-,I-,N-                                                               *)
  4. (*---------------------------------------------------------------------------*)
  5. UNIT LDRepl;
  6.  
  7.  
  8. INTERFACE
  9.  
  10.  
  11. USES
  12.    Dos,
  13.    MyType,
  14.    MyTool,
  15.    LDVari,
  16.    LDProc;
  17.  
  18.  
  19. PROCEDURE ReplaceJob;
  20.  
  21.  
  22. IMPLEMENTATION
  23.  
  24.  
  25. {$L LDE16 }
  26. FUNCTION EnCode16(inf,ouf:WORD;dsize,size:LONGINT):BOOLEAN;EXTERNAL;
  27. {$L LDE18 }
  28. FUNCTION EnCode18(inf,ouf:WORD;dsize,size:LONGINT):BOOLEAN;EXTERNAL;
  29.  
  30.  
  31. VAR
  32.   lh1size,lh2size,lh3size : WORD;
  33.  
  34.  
  35. PROCEDURE MakHdr;
  36. VAR
  37.    i : WORD;
  38.    d : DirStr;
  39.    n : NameStr;
  40.    e : ExtStr;
  41.    s : STRING;
  42. BEGIN
  43.    WITH lh1,lh2,lh3,LzdFN  DO BEGIN
  44.       FSplit(OldFName,d,n,e);
  45.       s:=n+e;
  46.       FSplit(NewFName,d,n,e);
  47.       LSize  :=NewSize;
  48.       LFSize :=NewFSize;
  49.       LTime  :=NewTime;
  50.       LAttr  :=NewAttr;
  51.       LFName :=n+e;
  52.       LHdrID :='-L';
  53.       LHdrSID:='D6-';
  54.       Lh1Size:=SizeOf(LHdr)-255+Length(LFName);
  55.       Lh2Size:=SizeOf(L2Hdr)-255+Length(s)+2;
  56.       Lh3Size:=SizeOf(L3Hdr);
  57.       LNum   :=Lh1Size+Lh2Size-2;
  58.       LCRC   :=CRC;
  59.       LOldCrc:=OldCRC;
  60.       LOldFSize:=OldFSize;
  61.       LOldName:=s;
  62.       LCTYPE:='N';
  63.       LEI:=EI;
  64.       LEJ:=EJ;
  65.       LOSType:='M';
  66.       LCSum:=0;
  67.       buf2[Lh2Size-2]:=3;
  68.       buf2[Lh2Size-1]:=0;
  69.       FOR i:=2 TO Lh1Size-1 DO Inc(LCSum,buf1[i]);
  70.       FOR i:=0 TO Lh2Size-1 DO Inc(LCSum,buf2[i]);
  71.       IF MaxLTime<LTime THEN MaxLTime:=LTime;
  72.    END;
  73. END;
  74.  
  75.  
  76. PROCEDURE ReplaceJob;
  77. VAR
  78.    s6 : STR6;
  79.    fs : LONGINT;
  80. CONST
  81.    EndOfLzs : BYTE = 0;
  82. BEGIN
  83.    MaxLTime:=0;
  84.    WITH LzdFN DO BEGIN
  85.       IF FExist(LzdFName)<>0 THEN BEGIN
  86.      IF NOT YesNo(LzdFName+' '+MEG(OverWriteMsg)) THEN Halt(1);END;
  87.       ReadDic(fs);
  88.       OldFSize:=fs;
  89.       OldCrc  :=CRC;
  90.       IF NOT BlkOpen(NewFVar,'I',NewFName) THEN Error(NewFName,CantOpenErMsg);
  91.       IF NOT BlkOpen(WrkFVar,'O',TName1) THEN Error(LzdFName,CantCreateErMsg);
  92.       NewFSize:=BlkFileSize(NewFVar);
  93.       GetBTime(NewFVar,NewTime);
  94.       GetBAttr(NewFVar,NewAttr);
  95.       WriteLn(OUTF,MEG(CreatingMsg)+' '+LzdFName+' '+MEG(FromMsg)+' '+
  96.            NewFName+' '+MEG(WithMsg)+' '+OldFName);
  97.       IF (OldFSize<$10000) AND (NewFSize<$10000) THEN BEGIN
  98.          EI:=16;EJ:=16;END
  99.       ELSE BEGIN
  100.          EI:=18;EJ:=14;END;
  101.       CRC:=0;
  102.       IF EI=16 THEN BEGIN
  103.          IF NOT EnCode16(NewFVar.Handle,WrkFVar.Handle,OldFSize,NewFSize) THEN
  104.         Error('',EncodeErMsg);END
  105.       ELSE BEGIN
  106.          IF NOT EnCode18(NewFVar.Handle,WrkFVar.Handle,OldFSize,NewFSize) THEN
  107.         Error('',EncodeErMsg);END;
  108.       BlkClose(NewFVar);
  109.       NewSize:=BlkFileSize(WrkFVar);
  110.       Str((NewSize/NewFSize)*100:6:2,s6);
  111.       WriteLn('  '+MEG(RatioMsg)+'('+s6+'%)');
  112.       MakHdr;
  113.       IF NOT BlkOpen(LzdFVar,'O',LzdFName) THEN Error(LzdFName,CantOpenErMsg);
  114.       BlkSeek(WrkFVar,0);
  115.       BlkWrite(LzdFVar,lh1,Lh1Size);
  116.       BlkWrite(LzdFVar,lh2,Lh2Size);
  117.       BlkWrite(LzdFVar,lh3,Lh3Size);
  118.       BlkCopy(WrkFVar,LzdFVar,NewSize);
  119.       BlkClose(WrkFVar);
  120.       BlkErase(WrkFVar);
  121.       BlkWrite(LzdFVar,EndOfLzs,1);
  122.       SetBTime(LzdFVar,MaxLTime);
  123.       BlkClose(LzdFVar);
  124.    END;
  125. END;
  126.  
  127.  
  128. END.
  129.