home *** CD-ROM | disk | FTP | other *** search
/ Fifty: Elektronik / FIFTY Elektronik (PS_Computer_Vertrieb).iso / ps8 / fty1017 / gepackt.exe / DISK2 / PLOTSRC.EXE / TEMPSTM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-10  |  9.5 KB  |  395 lines
  1. {$R-,A+,S-,I-}
  2. UNIT tempSTM;
  3.  
  4. INTERFACE
  5.  
  6. USES Dos,Objects;
  7.  
  8. Const LASTDRIVE:Char='Z'; { Letztes zu prüfendes Laufwerk bei suche nach
  9.                             temporärem Speicherplatz auf der Platte }
  10.       MediaEMS  =1; { Media-Konstanten spezifizieren Auslagerungs-Medium}
  11.       MediaXMS  =2;
  12.       MediaRDD  =4;
  13.       MediaHDD  =8;
  14.       MediaALL  =15;
  15.       MediaNone =0;
  16.  
  17. Procedure GetLastDrive; { bestimmt LASTDRIVE aus DOS-Commandline }
  18.                         { Format: /LD=<x>    z.B. /LD=F          }
  19.  
  20. TYPE
  21.   PTMPStream = ^TTMPStream;
  22.   TTMPStream = OBJECT (TStream)
  23.     ActualSTM     :PStream;
  24.     RequestedSize :Longint;
  25.     Extension     :ExtStr;
  26.     TempName      :PathStr;
  27.     ChainNext     :PtmpStream;
  28.     Media         :Word; {benutztes Speichermedium}
  29.     AllowedMedia  :Word;
  30.     CONSTRUCTOR Init(MinSize:Longint;Fileext:ExtStr);
  31.     DESTRUCTOR Done; virtual;
  32.     FUNCTION  GetPos: Longint; virtual;
  33.     FUNCTION  GetSize: Longint; virtual;
  34.     PROCEDURE Read(var Buf; Count: Word); virtual;
  35.     PROCEDURE Seek(Pos: Longint); virtual;
  36.     PROCEDURE Truncate; virtual;
  37.     PROCEDURE Write(var Buf; Count: Word); virtual;
  38.     PROCEDURE Origin;
  39.     Procedure Push(var Buf; Count: Word);
  40.     Procedure Pop(var Buf; Count: Word);
  41.   END;
  42.  
  43.  
  44. IMPLEMENTATION
  45. {$IFDEF DPMI}
  46. USES EMS,StrTool;
  47. {$ELSE}
  48. USES Xms,EMS,XMSStm,StrTool;
  49. {$ENDIF}
  50.  
  51. Const EMS_SIZE:Longint=0;
  52.       XMS_Size:Longint=0;
  53.       HDD_Size:Longint=0;
  54.       RDD_Size:Longint=0;
  55.       RAM_path:PathStr='';
  56.       TMP_Path:PathStr='';
  57.       NextStm :PTMPStream=nil;
  58.       
  59. function DriveValid(Drive: Char): Boolean; assembler;
  60. asm
  61.     MOV    DL,Drive
  62.         MOV    AH,36H
  63.         SUB    DL,'A'-1
  64.         INT    21H
  65.         INC    AX
  66.         JE    @@2
  67. @@1:    MOV    AL,1
  68. @@2:
  69. end;
  70.  
  71. Function GetTMPPath:Boolean;
  72. Var C,Drive:Char;
  73.     MaxDiskSpace,
  74.     Avail    :Longint;
  75.     SR       :SearchRec;
  76. Const AlreadyCalled:Boolean=false;
  77. begin
  78.   GetTMPpath:=true; { liefert immer true ! }
  79.   If AlreadyCalled then Exit;
  80.   AlreadyCalled:=true;
  81.   MaxDiskSpace:=0;
  82.   drive:=#0;
  83.   For C:='C' to LASTDRIVE do
  84.    begin
  85.      If DriveValid(C) then
  86.        begin
  87.          Avail:=Diskfree(Ord(C)-64);
  88.          FindFirst(C+':\*.*',VolumeID,SR);
  89.          If (dosError=0) and
  90.             ((Pos('VDISK',SR.Name)>0) or (Pos('RAM',SR.Name)>0)) then
  91.          begin
  92.            If RDD_Size=0 then
  93.            begin
  94.              RDD_Size:=Avail;
  95.              RAM_Path:=C+':\';
  96.              If tmp_path<>'' then Exit;
  97.            end;
  98.          end
  99.          else
  100.          begin
  101.            If Avail>MaxDiskSpace then
  102.             begin
  103.               MaxDiskSpace:=Avail;
  104.               Drive:=C;
  105.               Tmp_path:=drive+':\';
  106.               HDD_Size:=MaxDiskSpace;
  107.             end;
  108.          end;
  109.        end else Exit;
  110.    end;
  111. end;
  112.  
  113. Function GetEMSsize:Longint;
  114. Var AV,Dummy :Word;
  115. begin
  116.   EMMPageCount(AV,Dummy);
  117.   GetEMSsize:=Longint(AV)*16384;
  118. end;
  119.  
  120. Procedure GetRAM_Sizes;
  121. begin
  122.   If Ram_path<>'' then
  123.       RDD_Size:=DiskFree(Ord(Upcase(Ram_path[1]))-64);
  124.   If TestEMMDriver then
  125.       EMS_Size:=GetEMSsize;
  126.   {$IFDEF DPMI}
  127.   XMS_Size:=MaxAvail;
  128.   {$ELSE}
  129.   If XMS_DriverOk and (XMS_Result=XMSok) then
  130.       XMS_Size:=Longint(XMS.MaxAVAIL)*1024 else XMS_Size:=0;
  131.   {$ENDIF}
  132. end;
  133.  
  134. Procedure GetDisk_Size;
  135. begin
  136.   If tmp_path='' then Exit;
  137.   HDD_Size:=DiskFree(Ord(Upcase(Tmp_path[1]))-64);
  138. end;
  139.  
  140. Procedure EraseF(Var N:PathStr);
  141. Var F:File;
  142.     T:Word;
  143. begin
  144.   If N='' then Exit;
  145.   Assign(F,N);
  146.   {$I-}
  147.   Erase(F);
  148.   T:=Ioresult;
  149.   {$I+}
  150. end;
  151.  
  152. Function TMPSTM(Size :Longint;Ext:ExtStr;Var TName:String;Var Media:Word;Allowed:Word):Pstream;
  153. Var tmp    :Pstream;
  154. begin
  155.   tmp:=nil;
  156.   Tname:='';
  157.    If System.MaxAvail>1024 then
  158.     begin
  159.       GetRAM_Sizes;
  160.       If (XMS_Size>=Size) and (Allowed and MediaXMS>0) then
  161.         begin
  162.           {$IFDEF DPMI}
  163.           tmp:=New(PmemoryStream,Init(16384,16384));
  164.           {$ELSE}
  165.           tmp:=New(PXMSStream,Init);
  166.           {$ENDIF}
  167.           Media:=MediaXMS;
  168.         end
  169.         else If (EMS_Size>=Size) and (Allowed and MediaEMS>0) then
  170.          begin
  171.            tmp:=New(PEMSStream,Init(Size,Size*3 div 2));
  172.            Media:=MediaEMS;
  173.          end
  174.          else If GetTMPPath and (RDD_Size>=Size) and (Allowed and MediaRDD>0) then
  175.            begin
  176.              tName:=RandomFileName(RAM_Path,Ext);
  177.              tmp:=New(PDosStream,Init(tname,StCreate));
  178.              Media:=MediaRDD;
  179.            end
  180.            else
  181.              begin
  182.                If GetTMPpath then GETDisk_Size;
  183.                If (HDD_Size >=Size)  then
  184.                begin
  185.                  tName:=RandomFileName(TMP_Path,Ext);
  186.                  tmp:=New(PDosStream,Init(tname,StCreate));
  187.                  Media:=MediaHDD;
  188.                end;
  189.              end;
  190.     end;
  191.     If tmp<>nil then
  192.       If tmp^.Status<>Stok then
  193.         begin
  194.           Dispose(tmp,done);
  195.           tmp:=nil;
  196.           EraseF(Tname);
  197.         end;
  198.   TMPSTM:=TMP;
  199. end;
  200.  
  201. CONSTRUCTOR TTMPStream.Init;
  202.   BEGIN
  203.     Tstream.Init;
  204.     ActualStm:=nil;
  205.     RequestedSize:=MinSize;
  206.     ChainNext:=NextStm;
  207.     NextStm:=@self;
  208.     AllowedMedia:=MediaAll;
  209.     Extension    :=FileExt;
  210.     Repeat
  211.       TempName:='';
  212.       Status:=0;
  213.       ActualStm:=TMPSTM(Minsize,Extension,TempName,Media,AllowedMedia);
  214.       If ActualStm=nil then
  215.         begin
  216.          AllowedMedia:=AllowedMedia and Not(Media);
  217.          Status := stInitError;
  218.         end;
  219.     Until (ActualStm<>nil) or (AllowedMedia=MediaNone);
  220.     If ActualStm=nil then  ErrorInfo := 0;
  221.     If ActualStm<>nil then
  222.       With ActualStm^  do Self.Error(Status,ErrorInfo);
  223.   END;
  224.  
  225. DESTRUCTOR TTMPStream.Done;
  226.   Var tmp :PtmpStream;
  227.   BEGIN
  228.     If NextStm=@Self then
  229.       NextStm:=Nextstm^.ChainNext
  230.     else
  231.       begin
  232.         tmp:=NextStm;
  233.         While tmp<>nil do
  234.         begin
  235.           If Tmp^.ChainNext=@self then
  236.           begin
  237.             Tmp^.ChainNext:=ChainNext;  {Kettung für Exit-Proc freigeben}
  238.             Tmp:=nil;
  239.           end else tmp:=tmp^.ChainNext;
  240.        end;
  241.       end;
  242.     If ActualStm<>nil then Dispose(ActualStm,Done);
  243.     EraseF(Tempname);
  244.     TStream.Done;
  245.   END;
  246.  
  247. FUNCTION TTMPStream.GetPos: Longint;
  248.   BEGIN
  249.     GetPos := ActualStm^.Getpos;
  250.   END;
  251.  
  252. FUNCTION TTMPStream.GetSize: Longint;
  253.   BEGIN
  254.     GetSize :=ActualStm^.GetSize;
  255.   END;
  256.  
  257. PROCEDURE TTMPStream.Read(var Buf; Count: Word);
  258.   BEGIN
  259.     ActualStm^.Read(Buf,Count);
  260.     With ActualStm^  do Self.Error(Status,ErrorInfo);
  261.   END;
  262.  
  263. PROCEDURE TTMPStream.Seek(Pos: Longint);
  264.   BEGIN
  265.     ActualStm^.Seek(Pos);
  266.     With ActualStm^  do Self.Error(Status,ErrorInfo);
  267.   END;
  268.  
  269. PROCEDURE TTMPStream.Truncate;
  270.   BEGIN
  271.     ActualStm^.Truncate;
  272.     With ActualStm^  do Self.Error(Status,ErrorInfo);
  273.   END;
  274.  
  275. PROCEDURE TTMPStream.Write(var Buf; Count: Word);
  276.   Var OldError :Word;
  277.       OldInfo  :Word;
  278.       Temp     :Pstream;
  279.       NewSize  :Longint;
  280.       NewMedia :Word;
  281.       tmpName  :PathStr;
  282.       Ok       :Boolean;
  283.   BEGIN
  284.     With ActualStm^ Do
  285.     begin
  286.       OldError:=Status;
  287.       Write(Buf,Count);
  288.       If Status<>StOk then
  289.        If OldError=StOk then
  290.         If Media<>MediaHDD then
  291.         begin
  292.           OldInfo:=ErrorInfo;
  293.           OldError:=Status;
  294.           AllowedMedia:=AllowedMedia and Not(Media);
  295.           Reset;
  296.           Ok:=false;
  297.           Repeat
  298.             temp:=nil;
  299.             tmpname:='';
  300.             NewSize:=GetSize*3 div 2;
  301.             If NewSize<RequestedSize then
  302.                 NewSize:=RequestedSize;
  303.             temp:=TMPSTM(NewSize,Extension,tmpname,NewMedia,AllowedMedia);
  304.             If temp=nil then AllowedMedia:=AllowedMedia and Not(NewMedia);
  305.           Until (temp<>nil) or (AllowedMedia=MediaNone);
  306.           If (temp<>nil) then
  307.           begin
  308.             Origin;
  309.             temp^.CopyFrom(ActualStm^,ActualStm^.GetSize);
  310.             If temp^.Status<>StOk then dispose(temp,Done)
  311.             else
  312.               begin
  313.                 dispose(ActualStm,done);
  314.                 ActualStm:=temp;
  315.                 RequestedSize:=NewSize;
  316.                 Media        :=NewMedia;
  317.                 Ok:=true;
  318.                 tempname:=tmpname;
  319.                 temp^.Write(Buf,Count);
  320.               end;
  321.           end; {temp<>nil }
  322.           If Not Ok then
  323.            ActualStm^.Error(OldError,OldInfo);
  324.         end;
  325.       Self.Error(ActualStm^.Status,ActualStm^.ErrorInfo);
  326.     end;
  327.   END;
  328.  
  329. PROCEDURE TTMPStream.Origin;
  330. begin
  331.   ActualStm^.Flush;
  332.   ActualStm^.Reset;
  333.   ActualStm^.Seek(0);
  334. end;
  335.  
  336. PROCEDURE TTMPStream.Push(var Buf; Count: Word);
  337. begin
  338.   Write(Buf,Count);
  339. end;
  340.  
  341. PROCEDURE TTMPStream.Pop(var Buf; Count: Word);
  342. Var Pos,
  343.     ASize:Longint;
  344.  
  345. begin
  346.   ASize:=GetSize;
  347.   Pos:=Asize-Count;
  348.   If Pos<0 then
  349.    begin
  350.      count:=Asize;
  351.      Pos:=0;
  352.    end;
  353.   Seek(Pos);
  354.   Read(Buf,Count);
  355.   Seek(Pos);
  356.   Truncate;
  357. end;
  358.  
  359. Var Pexitold:Pointer;
  360.  
  361. Procedure MyExit; far;
  362. Var tmp:PtmpStream;
  363. begin
  364.   While NextStm<>nil do
  365.    begin
  366.      tmp:=NextStm;
  367.      NextStm:=NextStm^.ChainNext;
  368.      tmp^.done;
  369.    end;
  370.   ExitProc:=PexitOld;
  371. end;
  372.  
  373. Procedure GetLastDrive;
  374. Var tmp :PathStr;
  375.     I,J :Word;
  376.     Drive:Char;
  377. begin
  378.   Drive:=#0;
  379.   For I:=1 to ParamCount do
  380.    begin
  381.      tmp:=ParamStr(I);
  382.      For J:=1 to Byte(tmp[0]) do tmp[J]:=Upcase(tmp[J]);
  383.      If (Pos('/LD=',tmp)=1) and (tmp[0]>#5) then
  384.        Drive:=TMP[5];
  385.    end;
  386.   If (Drive>='C') and (Drive<='Z') then LastDrive:=Drive;
  387. end;
  388.  
  389. begin
  390.   Pexitold:=ExitProc;
  391.   ExitProc:=@MyExit;
  392.   GetRam_Sizes;
  393. END.
  394.  
  395.