{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█                                                       █}
{█      Virtual Pascal Examples  Version 1.10            █}
{█      Example DLL extending OS/2 REXX                  █}
{█      ─────────────────────────────────────────────────█}
{█      Copyright (C) 1995-96 fPrint UK Ltd              █}
{█                                                       █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

Library RexxExt;

Uses
  Use32, Dos, Os2Def, Os2Rexx, Strings;

{$CDecl+,OrgName+,I-,S-,Delphi+}

{$IFDEF VPDEMO}
  {&Dynamic VP11Demo.Lib}
{$ENDIF}

{$D REXXEXT - Virtual Pascal for OS/2 v1.10 Demo}    // DLL description

{$LINKER
  DATA MULTIPLE NONSHARED

  EXPORTS
    VPTOUCH      = VPTouch
    VPTEST       = VPTest
    SYSLOADFUNCS = SysLoadFuncs
}

Const
  FunctionTable : Array[ 0..1 ] of pChar
                = ( 'VPTouch',
                    'VPTest' );

Function SysLoadFuncs( FuncName  : PChar;
                       ArgC      : ULong;
                       Args      : pRxString;
                       QueueName : pChar;
                       Var Ret   : RxString ) : ULong; export;
Var
  j       : Integer;

begin
  Ret.strLength := 0;
  If ArgC > 0 then                        { Do not allow parameters }
    SysLoadFuncs := 40
  else
    begin
      For j := Low( FunctionTable ) to High( FunctionTable ) do
        RexxRegisterFunctionDLL( FunctionTable[j],
                                 'REXXEXT',
                                 FunctionTable[j] );
      SysLoadFuncs := 0;
    end;

end;

{ Returns current date & time in the packed file format }

function GetDateTime: Longint;
var
  DT         : DateTime;
  DayOfWeek  : Word;
  Sec100     : Word;
  Time       : Longint;

begin
  GetDate(DT.Year, DT.Month, DT.Day, DayOfWeek);
  GetTime(DT.Hour, DT.Min  , DT.Sec, Sec100);
  PackTime(DT, Time);
  GetDateTime := Time;
end;

Function VPTouch( FuncName  : PChar;
                  ArgC      : ULong;
                  Args      : pRxString;
                  QueueName : pChar;
                  Var Ret   : RxString ) : ULong; export;
var
  Time    : Longint;
  I       : Integer;
  SR      : SearchRec;
  F       : File;
  FName   : PathStr;
  Dir     : DirStr;
  Name    : NameStr;
  Ext     : ExtStr;
  FileSpec: String;
  rc      : ULong;
  s : String;

begin
  If ArgC = 0 then
    begin
      VPTouch := 40;                      { At least one parameter required }
      Exit;
    end;

  Time := GetDateTime;
  rc := 0;
  For i := 1 to ArgC do                   { For all arguments... }
    begin
      FileSpec := StrPas( Args^.strptr );
      s := s + FileSpec;
      FSplit( FileSpec, Dir, Name, Ext );
      FindFirst( FileSpec, 0, SR );
      while ( rc = 0 ) and ( DosError = 0 ) do
        begin
          FName := Dir + SR.Name;
          Assign(F, FName);
          FileMode := $2011;
          Reset(F);
          if IOResult <> 0 then
            rc := 1;
          SetFTime(F, Time);
          if DosError <> 0 then
            rc := 2;
          Close(F);
          InOutRes := 0;
          FindNext(SR);
        end; { While DosError = 0 }
      FindClose(SR);
      Inc( Args );
    end; { For i }
  str( rc, s );
  Ret.strLength := Length(s);
  strpcopy( Ret.strptr, s );
  VPTouch := 0;
end;

Function VPTest( Name      : PChar;
                 ArgC      : ULong;
                 Args      : pRxString;
                 QueueName : pChar;
                 Var Ret   : RxString ) : ULong; export;
begin
  Ret.StrPtr := 'VP/2 Test REXX Function';
  Ret.strLength := strlen( Ret.StrPtr );
  VPTest := 0;
end;

initialization
end.