Browse Source

* updates for OS2
* small fixes

peter 27 years ago
parent
commit
4cbc19ed93
3 changed files with 153 additions and 68 deletions
  1. 70 35
      install/install.pas
  2. 17 5
      install/unzip.pas
  3. 66 28
      install/ziptypes.pas

+ 70 - 35
install/install.pas

@@ -16,12 +16,29 @@
  **********************************************************************}
 program install;
 
+{$DEFINE FV}
+
+{$IFDEF OS2}
+ {$UNDEF FV}
+{$ENDIF}
+
   uses
-{$ifdef HEAPTRC}
-     heaptrc,
-{$endif HEAPTRC}
+{$IFDEF OS2}
+ {$IFDEF FPC}
+     DosCalls,
+ {$ELSE FPC}
+  {$IFDEF VirtualPascal}
+     OS2Base,
+  {$ELSE VirtualPascal}
+     BseDos,
+  {$ENDIF VirtualPascal}
+ {$ENDIF FPC}
+{$ENDIF OS2}
      strings,dos,objects,drivers,
-     commands,app,dialogs,views,menus,msgbox,
+{$IFDEF FV}
+     commands,
+{$ENDIF}
+     app,dialogs,views,menus,msgbox,
      unzip,ziptypes;
 
   const
@@ -30,12 +47,6 @@ program install;
 
      cfgfile='install.dat';
 
-{$ifdef linux}
-     DirSep='/';
-{$else}
-     DirSep='\';
-{$endif}
-
   type
      tpackage=record
        name : string[60];
@@ -45,7 +56,7 @@ program install;
      cfgrec=record
        title    : string[80];
        version  : string[20];
-       basepath : string[80];
+       basepath : DirStr;
        binsub   : string[12];
        ppc386   : string[12];
        packages : longint;
@@ -56,7 +67,7 @@ program install;
      end;
 
      datarec=packed record
-       basepath : string[80];
+       basepath : DirStr;
        mask     : word;
      end;
 
@@ -168,7 +179,7 @@ program install;
     end;
 
 
-  function createdir(var s : string) : boolean;
+  function createdir(s : string) : boolean;
     var
       start,
       s1 : string;
@@ -179,38 +190,44 @@ program install;
     begin
        if s[length(s)]=DirSep then
         dec(s[0]);
-       s:=lower(s);
-       FindFirst(s,$ff,dir);
+       FindFirst(s,AnyFile,dir);
        if doserror=0 then
          begin
             result:=messagebox('The installation directory exists already. '+
-              'Do want to enter a new installation directory ?',nil,
+              'Do you want to enter a new installation directory ?',nil,
               mferror+mfyesbutton+mfnobutton);
             createdir:=(result=cmNo);
             exit;
          end;
        err:=false;
        {$I-}
-       getdir(0,start);	 
+       getdir(0,start);
+{$ifndef linux}
+       if (s[2]=':') and (s[3]=DirSep) then
+        begin
+          chdir(Copy(s,1,3));
+          Delete(S,1,3);
+        end;
+{$endif}
        repeat
          i:=Pos(DirSep,s);
-	 if i=0 then
-	  i:=255;
+         if i=0 then
+          i:=255;
          s1:=Copy(s,1,i-1);
-	 Delete(s,1,i);
-	 ChDir(s1);
-	 if ioresult<>0 then
-	  begin
-	    mkdir(s1);
-	    chdir(s1);
-	    if ioresult<>0 then
-	     begin
-	       err:=true;
-  	       break;
-	     end;  
-	  end;
+         Delete(s,1,i);
+         ChDir(s1);
+         if ioresult<>0 then
+          begin
+            mkdir(s1);
+            chdir(s1);
+            if ioresult<>0 then
+             begin
+               err:=true;
+               break;
+             end;
+          end;
        until s='';
-       chdir(start);	 
+       chdir(start);
        {$I+}
        if err then
          begin
@@ -220,6 +237,9 @@ program install;
             createdir:=false;
             exit;
          end;
+{$ifndef TP}
+       FindClose (dir);
+{$endif}
        createdir:=true;
     end;
 
@@ -296,7 +316,7 @@ program install;
          end;
        fn:=startpath+DirSep+s+#0;
        dir:=topath+#0;
-       wild:='*.*'#0;
+       wild:=AllFiles + #0;
        FileUnzipEx(@fn[1],@dir[1],@wild[1]);
        if doserror<>0 then
          begin
@@ -360,7 +380,7 @@ program install;
        line:=2;
        r.assign(3,line+1,28,line+2);
 
-       f:=new(pinputline,init(r,80));
+       f:=new(pinputline,init(r,high(DirStr)));
        insert(f);
 
        r.assign(3,line,8,line+1);
@@ -607,6 +627,17 @@ program install;
 
 
 begin
+{$IFDEF OS2}
+ {$IFDEF FPC}
+   DosCalls.DosError (0);
+ {$ELSE FPC}
+  {$IFDEF VirtualPascal}
+   OS2Base.DosError (ferr_DisableHardErr);
+  {$ELSE VirtualPascal}
+   BseDos.DosError (0);
+  {$ENDIF VirtualPascal}
+ {$ENDIF FPC}
+{$ENDIF}
    getdir(0,startpath);
    successfull:=false;
 
@@ -620,7 +651,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.13  1998-12-21 13:11:39  peter
+  Revision 1.14  1998-12-22 22:47:34  peter
+    * updates for OS2
+    * small fixes
+
+  Revision 1.13  1998/12/21 13:11:39  peter
     * updates for 0.99.10
 
   Revision 1.12  1998/12/16 00:25:34  peter

+ 17 - 5
install/unzip.pas

@@ -1,6 +1,18 @@
 UNIT Unzip;
 INTERFACE
 
+{$IFDEF FPC}
+ {$DEFINE BIT32}
+{$ENDIF}
+
+{$IFDEF OS2}
+ {$DEFINE BIT32}
+{$ENDIF}
+
+{$IFDEF WIN32}
+ {$DEFINE BIT32}
+{$ENDIF}
+
 {$IFNDEF FPC}
   {$F+}
 {$ENDIF}
@@ -270,7 +282,7 @@ CONST   {Error codes returned by huft_build}
   huft_incomplete = 1;   {Incomplete tree <- sufficient in some cases!}
   huft_error     = 2;   {bad tree constructed}
   huft_outofmem  = 3;   {not enough memory}
-  MaxMax = {$ifdef Win32}256 * 1024    {Win32 =  256kb buffer}
+  MaxMax = {$ifdef BIT32}256 * 1024    {BIT32 =  256kb buffer}
            {$else}Maxint -1{$endif}; {16-bit = 32kb buffer}
 
 CONST wsize = $8000;          {Size of sliding dictionary}
@@ -2390,7 +2402,7 @@ BEGIN
       {$I+}
       err := ioresult;
       {$endif}
-      p := strtok ( p, '\' );
+      p := strtok ( NIL, '\' );
     END;
 {$endif}
     WHILE ( p <> NIL ) AND ( p <> p1 ) DO BEGIN
@@ -2427,7 +2439,7 @@ BEGIN
           err := ioresult;
       END;
       IF err = 0 THEN
-        p := strtok ( p, DirSep )
+        p := strtok ( NIL, DirSep )
       ELSE
         p := NIL;
     END;
@@ -2806,7 +2818,7 @@ VAR
     l, err : integer;
     f : file;
     buf : ARRAY [ 0..4 ] of char;
-    oldcurdir : string{$ifndef Win32} [ 80 ]{$endif};
+    oldcurdir : string{$ifndef BIT32} [ 80 ]{$endif};
 
 BEGIN
   filemode := 0;
@@ -2928,7 +2940,7 @@ b : boolean;
 i : integer;
 BEGIN
    Matches := TRUE;
-   IF ( s = '' ) OR ( s = '*.*' ) THEN exit; {'' or '*.*' = all files match}
+   IF ( s = '' ) OR ( s = AllFiles ) THEN exit; {'' or '*.*' = all files match}
    s := upper ( s );
    b := copy ( s, 1, 2 ) = '*.';  {e.g., *.PAS}
    IF b THEN BEGIN

+ 66 - 28
install/ziptypes.pas

@@ -1,27 +1,64 @@
 UNIT ziptypes;
+{
+Type definitions for UNZIP
+  * original version by Christian Ghisler
+  * extended
+    and
+    amended for Win32 by Dr Abimbola Olowofoyeku (The African Chief)
+ Homepage: http://ourworld.compuserve.com/homepages/African_Chief
+  * extended to by Tomas Hajny, [email protected] to support other 32-bit
+    compilers/platforms (OS/2, GO32, ...); search for (* TH ... *)
+}
+
+{$IFDEF FPC}
+ {$DEFINE BIT32}
+{$ENDIF}
+
+{$IFDEF OS2}
+ {$DEFINE BIT32}
+{$ENDIF}
+
+{$IFDEF WIN32}
+ {$DEFINE BIT32}
+{$ENDIF}
+
+
 INTERFACE
 
+{$ifdef BIT32}
+TYPE
+  nWord   = longint;
+  Integer = Longint; {Default Integer is 16 bit!}
+{$else BIT32}
 TYPE
-  nWord = Longint;
-  Integer = Longint;
+  nWord = Word;
+{$endif BIT32}
 
 CONST
-  tBufSize = 256*1024;     {buffer size}
-  tFSize   = 255;          {filename length}
+  tBufSize = {$ifdef BIT32}256{$else}63{$endif} * 1024;   {buffer size}
+  tFSize   = {$ifdef BIT32}259{$else}79{$endif};          {filename length}
+
+{$IFDEF OS2}
+  AllFiles = '*';
+{$ELSE}
+  {$ifdef linux}
+  AllFiles = '*';
+  {$else}
+  AllFiles = '*.*';
+  {$endif}
+{$ENDIF}
 
 {$ifdef linux}
-  DirSep = '/';
+  DirSep='/';
 {$else}
-  DirSep = '\';
+  DirSep='\';
 {$endif}
 
-
-{ Record for UNZIP }
 TYPE
-     buftype  = ARRAY [ 0..tBufSize ] of char;
-     TDirtype = ARRAY [ 0..tFSize ] of char;
-
-     TZipRec = PACKED RECORD
+  { Record for UNZIP }
+  buftype  = ARRAY [ 0..tBufSize ] of char;
+  TDirtype = ARRAY [ 0..tFSize ] of char;
+  TZipRec = PACKED RECORD
        buf : ^buftype;        {please}         {buffer containing central dir}
        bufsize,               {do not}         {size of buffer}
        localstart : word;     {change these!}  {start pos in buffer}
@@ -32,11 +69,11 @@ TYPE
        FileName : tdirtype;
        PackMethod : word;
        Attr : Byte;
-     END; { TZipRec }
+  END; { TZipRec }
 
-{ record for callback progress Reports, etc. }
-     pReportRec = ^TReportRec;     {passed to callback functions}
-     TReportRec = PACKED RECORD
+  { record for callback progress Reports, etc. }
+  pReportRec = ^TReportRec;     {passed to callback functions}
+  TReportRec = PACKED RECORD
        FileName : tdirtype;   {name of individual file}
        Time,                  {date and time stamp of individual file}
        Size,                  {uncompressed and time stamp of individual file}
@@ -46,7 +83,7 @@ TYPE
        Ratio : byte;          {compression ratio of individual file}
        Status : longint;      {callback status code to show where we are}
        IsaDir : Boolean;      {is this file a directory?}
-     END; {TReportRec}
+  END; {TReportRec}
 
 { callback status codes }
 CONST
@@ -60,7 +97,7 @@ CONST
 
 { procedural types for callbacks }
 TYPE
-  UnzipReportProc  = PROCEDURE ( Retcode : longint;Rec : pReportRec );
+  UnzipReportProc  = PROCEDURE ( Retcode : longint;Rec : pReportRec );{$ifdef Delphi32}STDCALL;{$endif}
 { procedural type for "Report" callback: the callback function
   (if any) is called several times during the unzip process
 
@@ -85,6 +122,7 @@ TYPE
 }
 
 UnzipQuestionProc = FUNCTION ( Rec : pReportRec ) : Boolean;
+{$ifdef Delphi32}STDCALL;{$endif}
 { procedural type for "Question" callback:if a file already
   exists, the callback (if any) will be called to ask whether
   the file should be overwritten by the one in the ZIP file;
@@ -119,28 +157,28 @@ CONST
 
 { the various unzip methods }
 CONST
-  Unzipmethods : ARRAY [ 0..9 ] of pchar =
-   ( 'stored', 'shrunk', 'reduced 1', 'reduced 2', 'reduced 3',
-     'reduced 4', 'imploded', 'tokenized', 'deflated', 'skipped' );
+Unzipmethods : ARRAY [ 0..9 ] of pchar =
+  ( 'stored', 'shrunk', 'reduced 1', 'reduced 2', 'reduced 3',
+   'reduced 4', 'imploded', 'tokenized', 'deflated', 'skipped' );
 
 { unzip actions being undertaken }
-  UnzipActions : ARRAY [ 0..9 ] of pchar =
-   ( 'copying', 'unshrinking', 'unreducing 1', 'unreducing 2', 'unreducing 3',
-     'unreducing 4', 'exploding', 'un-tokenizing', 'inflating', 'skipping' );
+CONST
+UnzipActions : ARRAY [ 0..9 ] of pchar =
+  ( 'copying', 'unshrinking', 'unreducing 1', 'unreducing 2', 'unreducing 3',
+   'unreducing 4', 'exploding', 'un-tokenizing', 'inflating', 'skipping' );
 
 { rudimentary "uppercase" function }
-FUNCTION Upper (s : String ) : String;
+FUNCTION Upper ( s : String ) : String;
 
 { remove path and return filename only }
 FUNCTION StripPath ( CONST s : String ) : String;
 
 IMPLEMENTATION
 
-FUNCTION Upper (s : String ) : String;
+FUNCTION Upper ( s : String ) : String;
 VAR i : integer;
 BEGIN
-   FOR i := 1 TO length ( s ) DO
-     s [ i ] := Upcase ( s [ i ] );
+   FOR i := 1 TO length ( s ) DO s [ i ] := Upcase ( s [ i ] );
    Upper := s;
 END;