dws2mflibmodule.pas

script language

procedure Tdws2MFLib.dws2UnitBasicFunctionsSleepEval(Info: TProgramInfo);
begin
  Sleep(Info['mSecs']);
end;

procedure Tdws2MFLib.dws2UnitBasicFunctionsWriteLnEval(Info: TProgramInfo);
begin
  WriteLn(Info['Text']);
end;

// ****************************************************************************
// *** Connection Functions ***************************************************
// ****************************************************************************

procedure Tdws2MFLib.dws2UnitConnFunctionsConnectedEval(
  Info: TProgramInfo);
var
  InternetGetConnectedState: function(lpdwFlags: LPDWord;
    dwReserved: DWord
    ): Boolean; stdcall;
  RasEnumConnections: TRasEnumConnections;
  RasConns: array[1..15] of TRasConn;
  Entries,
    Bufsize: DWord;

  Flags,
    Dummy: LongInt;
  hRasApi,
    hWinInet: THandle;
begin
  Info['Result'] := False;
  hRasApi := LoadLibrary('rasapi32');
  if hRasApi <> 0 then
  try
    RasEnumConnections := GetProcAddress(hRasApi, 'RasEnumConnectionsA');
    if @RasEnumConnections <> nil then
    begin
      FillChar(RasConns, Sizeof(RasConns), 0);
      RasConns[1].Size := Sizeof(TRasConn);
      Bufsize := Sizeof(RasConns);
      if RasEnumConnections(@RasConns[1], Bufsize, Entries) = 0 then
        if Entries > 0 then
        begin
          Info['Result'] := True;
          Exit;
        end;
    end;
  finally
    FreeLibrary(hRasApi);
  end;
  Dummy := 0;
  hWinInet := LoadLibrary('wininet');
  if hWinInet <> 0 then
  try
    InternetGetConnectedState := GetProcAddress(hWininet,
      'InternetGetConnectedState');
    if @InternetGetConnectedState <> nil then
    begin
      if InternetGetConnectedState(@Flags, Dummy) then
      begin
        Info['Result'] := True;
        Exit;
      end;
    end;
  finally
    FreeLibrary(hWinInet);
  end;
end;

procedure Tdws2MFLib.dws2UnitConnFunctionsIPAddressEval(
  Info: TProgramInfo);
var
  wVersionRequested: Word;
  wsaData: TWSAData;
  p: PHostEnt;
  s: array[0..128] of Char;
  p2: PChar;
begin
  {Start up WinSock}
  wVersionRequested := MakeWord(1, 1);
  WSAStartup(wVersionRequested, wsaData);

  {Get the computer name}
  GetHostName(@s, 128);
  p := GetHostByName(@s);

  {Get the IpAddress}
  p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
  Info['Result'] := string(p2);

  {Shut down WinSock}
  WSACleanup;
end;

// ****************************************************************************
// *** Dialog Functions *******************************************************
// ****************************************************************************

procedure Tdws2MFLib.dws2UnitDialogFunctionsSelectStringDialogEval(
  Info: TProgramInfo);
var
  ScriptObj: IScriptObj;
  StringsObj: TStringList;
begin
  ScriptObj := IScriptObj(IUnknown(Info['Strings']));
  if ScriptObj = nil then
    StringsObj := nil
  else
    StringsObj := TStringList(ScriptObj.ExternalObject);
  Info['Result'] := SelectStringDialog( Info['Title'], StringsObj, Info['Selected'] );
end;

// ****************************************************************************
// *** File Functions *********************************************************
// ****************************************************************************

procedure Tdws2MFLib.dws2UnitFileFunctionsDescCopyEval(Info: TProgramInfo);
begin
  Info['Result'] := DescWrite(Info['Target'], DescRead(Info['Source']));
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsDescListCreateEval(
  Info: TProgramInfo);
var
  SL: TStringList;
begin
  SL := DescListCreate(Info['Dir']);
  if Assigned(SL) then
    Info['Result'] := Info.Vars['TStringList'].GetConstructor('Create', SL).Call.Value
  else
    Info['Result'] := 0;
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsDescListReadEval(
  Info: TProgramInfo);
var
  ScriptObj: IScriptObj;
  StringsObj: TStringList;
begin
  ScriptObj := IScriptObj(IUnknown(Info['List']));
  if ScriptObj = nil then
    StringsObj := nil
  else
    StringsObj := TStringList(ScriptObj.ExternalObject);
  Info['Result'] := DescListRead(StringsObj, Info['FileName']);
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsDescMoveEval(Info: TProgramInfo);
begin
  Info['Result'] := DescWrite(Info['Target'], DescRead(Info['Source']));
  if Info['Result'] then
    DescWrite(Info['Source'], '');
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsDescReadEval(Info: TProgramInfo);
begin
  Info['Result'] := DescRead(Info['Filename']);
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsDescWriteEval(
  Info: TProgramInfo);
begin
  Info['Result'] := DescWrite(Info['FileName'], Info['Desc']);
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsOpenDialogEval(
  Info: TProgramInfo);
var
  OD: TExtOpenDialog;
begin
  Info['Result'] := '';
  try
    OD := TExtOpenDialog.Create(nil);
    try
      OD.InitialDir := Info['InitialDir'];
      OD.FileName := Info['FileName'];
      OD.Title := Info['Title'];
      OD.DefaultExt := Info['DefaultExt'];
      OD.Filter := Info['Filter'];
      OD.FilterIndex := Info['FilterIndex'];
      OD.Options := [ofHideReadOnly, ofPathMustExist, ofFileMustExist,
        ofEnableSizing];
      if OD.Execute then
        Info['Result'] := OD.FileName;
    finally
      OD.Free;
    end;
  except
    ;
  end;
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsOpenDialogMultiEval(
  Info: TProgramInfo);
var
  OD: TExtOpenDialog;
  SL: TStringList;
begin
  Info['Result'] := 0;
  OD := TExtOpenDialog.Create(nil);
  try
    OD.InitialDir := Info['InitialDir'];
    OD.FileName := Info['FileName'];
    OD.Title := Info['Title'];
    OD.DefaultExt := Info['DefaultExt'];
    OD.Filter := Info['Filter'];
    OD.FilterIndex := Info['FilterIndex'];
    OD.Options := [ofHideReadOnly, ofAllowMultiSelect, ofPathMustExist,
      ofFileMustExist, ofEnableSizing];
    if OD.Execute then
    begin
      SL := TStringList.Create;
      SL.AddStrings(OD.Files);
      SL.Sort;
      Info['Result'] := Info.Vars['TStringList'].GetConstructor('Create', SL).Call.Value;
    end;
  finally
    OD.Free;
  end;
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsSaveDialogEval(
  Info: TProgramInfo);
var
  SD: TExtSaveDialog;
begin
  Info['Result'] := '';
  try
    SD := TExtSaveDialog.Create(nil);
    try
      SD.InitialDir := Info['InitialDir'];
      SD.FileName := Info['FileName'];
      SD.Title := Info['Title'];
      SD.DefaultExt := Info['DefaultExt'];
      SD.Filter := Info['Filter'];
      SD.FilterIndex := Info['FilterIndex'];
      SD.Options := [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist,
        ofEnableSizing];
      if SD.Execute then
        Info['Result'] := SD.FileName;
    finally
      SD.Free;
    end;
  except
    ;
  end;
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsCDCloseEval(Info: TProgramInfo);
var
  Drive: Integer;
begin
  Drive := Info['Drive'];
  Info['Result'] := CDClose(Drive);
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsCDOpenEval(Info: TProgramInfo);
var
  Drive: Integer;
begin
  Drive := Info['Drive'];
  Info['Result'] := CDOpen(Drive);
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsGetCRC32FromFileEval(
  Info: TProgramInfo);
begin
  Info['Result'] := GetCRC32FromFile(Info['Filename']);
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsGetDriveNameEval(
  Info: TProgramInfo);
var
  Drive: Integer;
begin
  Drive := Info['Drive'];
  Info['Result'] := DriveName(Drive);
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsGetDriveNumEval(
  Info: TProgramInfo);
var
  Drive: string;
begin
  Drive := Info['Drive'];
  if (Length(Drive) = 1) or // Nur ein Zeichen
  ((Length(Drive) > 1) and (Drive[2] = #58)) then // oder zweites Zeichen ein ":"
    Info['Result'] := Ord(UpCase(Drive[1])) - 64
  else
    Info['Result'] := -1;
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsGetDriveReadyEval(
  Info: TProgramInfo);
var
  Drive: Integer;
begin
  Drive := Info['Drive'];
  Info['Result'] := DriveReady(Drive);
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsGetDriveSerialEval(
  Info: TProgramInfo);
var
  Drive: Integer;
begin
  Drive := Info['Drive'];
  Info['Result'] := DriveSerial(Drive);
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsGetDriveTypeEval(
  Info: TProgramInfo);
var
  Drive: Integer;
begin
  Drive := Info['Drive'];
  Info['Result'] := DriveType(Drive);
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsDirectoryExistsEval(
  Info: TProgramInfo);
begin
  Info['Result'] := DirectoryExists(Info['DirName']);
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsDirectoryListEval(
  Info: TProgramInfo);
var
  SL: TStringList;
begin
  SL := ScanForFiles(Info['DirName'] + '\*', Info['Recurse'], Info['Hidden'],
    False, True);
  Info['Result'] := Info.Vars['TStringList'].GetConstructor('Create', SL).Call.Value;
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsCopyFileEval(Info: TProgramInfo);
var
  Source,
    Target: string;
begin
  Source := Info['Source'];
  Target := Info['Target'];
  Info['Result'] := CopyFile(PChar(Source), PChar(Target), Info['Fail']);
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsFileDateEval(Info: TProgramInfo);
begin
  Info['Result'] := FileDate(Info['FileName'], Info['Flag']);
end;