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

+ 17 - 5
install/unzip.pas

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

+ 66 - 28
install/ziptypes.pas

@@ -1,27 +1,64 @@
 UNIT ziptypes;
 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
 INTERFACE
 
 
+{$ifdef BIT32}
+TYPE
+  nWord   = longint;
+  Integer = Longint; {Default Integer is 16 bit!}
+{$else BIT32}
 TYPE
 TYPE
-  nWord = Longint;
-  Integer = Longint;
+  nWord = Word;
+{$endif BIT32}
 
 
 CONST
 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}
 {$ifdef linux}
-  DirSep = '/';
+  DirSep='/';
 {$else}
 {$else}
-  DirSep = '\';
+  DirSep='\';
 {$endif}
 {$endif}
 
 
-
-{ Record for UNZIP }
 TYPE
 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}
        buf : ^buftype;        {please}         {buffer containing central dir}
        bufsize,               {do not}         {size of buffer}
        bufsize,               {do not}         {size of buffer}
        localstart : word;     {change these!}  {start pos in buffer}
        localstart : word;     {change these!}  {start pos in buffer}
@@ -32,11 +69,11 @@ TYPE
        FileName : tdirtype;
        FileName : tdirtype;
        PackMethod : word;
        PackMethod : word;
        Attr : Byte;
        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}
        FileName : tdirtype;   {name of individual file}
        Time,                  {date and time stamp of individual file}
        Time,                  {date and time stamp of individual file}
        Size,                  {uncompressed 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}
        Ratio : byte;          {compression ratio of individual file}
        Status : longint;      {callback status code to show where we are}
        Status : longint;      {callback status code to show where we are}
        IsaDir : Boolean;      {is this file a directory?}
        IsaDir : Boolean;      {is this file a directory?}
-     END; {TReportRec}
+  END; {TReportRec}
 
 
 { callback status codes }
 { callback status codes }
 CONST
 CONST
@@ -60,7 +97,7 @@ CONST
 
 
 { procedural types for callbacks }
 { procedural types for callbacks }
 TYPE
 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
 { procedural type for "Report" callback: the callback function
   (if any) is called several times during the unzip process
   (if any) is called several times during the unzip process
 
 
@@ -85,6 +122,7 @@ TYPE
 }
 }
 
 
 UnzipQuestionProc = FUNCTION ( Rec : pReportRec ) : Boolean;
 UnzipQuestionProc = FUNCTION ( Rec : pReportRec ) : Boolean;
+{$ifdef Delphi32}STDCALL;{$endif}
 { procedural type for "Question" callback:if a file already
 { procedural type for "Question" callback:if a file already
   exists, the callback (if any) will be called to ask whether
   exists, the callback (if any) will be called to ask whether
   the file should be overwritten by the one in the ZIP file;
   the file should be overwritten by the one in the ZIP file;
@@ -119,28 +157,28 @@ CONST
 
 
 { the various unzip methods }
 { the various unzip methods }
 CONST
 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 }
 { 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 }
 { rudimentary "uppercase" function }
-FUNCTION Upper (s : String ) : String;
+FUNCTION Upper ( s : String ) : String;
 
 
 { remove path and return filename only }
 { remove path and return filename only }
 FUNCTION StripPath ( CONST s : String ) : String;
 FUNCTION StripPath ( CONST s : String ) : String;
 
 
 IMPLEMENTATION
 IMPLEMENTATION
 
 
-FUNCTION Upper (s : String ) : String;
+FUNCTION Upper ( s : String ) : String;
 VAR i : integer;
 VAR i : integer;
 BEGIN
 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;
    Upper := s;
 END;
 END;