auxproj.pas

boomerang library 5.11 internet ed

(* AuxProj - auxiliary project library
 * Copyright (C) 1991,1993 Tomas Mandys-MandySoft
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public
 * License as published by the Free Software Foundation; either
 * version 2.1 of the License, or (at your option) any later version.
 *
 * This library is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330,
 * Boston, MA  02111-1307  USA
 *)

{ URL: http://www.2p.cz }

unit AuxProj;

interface
uses
  IniFiles, SysUtils, Windows;

function GetProgramPath: string;
procedure AdjustPath(var S: string; aSlash: Char = '\');

function LocalMachine: string;

procedure WinExecAndWait(aCmd: string; aMode: Integer = SW_SHOW); { spusti program a ceka dokud neskonci cinnost }
function CheckShellExecute(Err: Integer): Integer;

function ScramblePass(const aPass: string): string;

type
  EProjError = class(Exception)
  end;

procedure ProjError(const Msg: string);

var
  Ini: TCustomIniFile;

implementation
uses
  CmdLine{$IFDEF CLR}, System.Text{$ENDIF};

resourcestring
  sLastError = 'Error "%s": %.4x';

procedure ProjError(const Msg: string);
begin
  raise EProjError.Create(Msg);
end;

procedure AdjustPath;
begin
  if (S <> '') and not (S[Length(S)] in ['\',':','/']) then
    S:= S+aSlash;
end;

function GetProgramPath;
begin
  Result:= ExtractFilePath(ExpandFileName(ParamStr(0)));
  AdjustPath(Result);
end;

procedure WinExecAndWait;
var
  aStartupInfo: TStartupInfo;
  aProcessInformation: TProcessInformation;
  aExitCode: Cardinal;
  Attr: TSecurityAttributes;
  {$IFDEF CLR}
  SB: StringBuilder;
  {$ENDIF}
begin
  aCmd:= aCmd+#0;
  {$IFNDEF CLR}
  FillChar(aStartupInfo, SizeOf(aStartupInfo), 0);
  {$ENDIF}
  aStartupInfo.CB:= SizeOf(aStartupInfo);
  with aStartupInfo do
  begin
    dwFlags:= startf_UseShowWindow;
    wShowWindow:= aMode;
  end;
  Attr.nLength:= SizeOf(Attr);
  Attr.lpSecurityDescriptor:= nil;
  Attr.bInheritHandle:= True;
  {$IFDEF CLR}
  SB:= StringBuilder.Create(Length(aCmd));
  SB.Append(aCmd);
  {$ENDIF}
  if not CreateProcess({$IFDEF CLR}''{$ELSE}nil{$ENDIF}, {$IFDEF CLR}SB{$ELSE}@aCmd[1]{$ENDIF}, {$IFNDEF CLR}@{$ENDIF}Attr, {$IFNDEF CLR}@{$ENDIF}Attr, True, Normal_Priority_Class, {$IFDEF CLR}''{$ELSE}nil{$ENDIF}, {$IFDEF CLR}''{$ELSE}nil{$ENDIF}, aStartupInfo, aProcessInformation) then
    ProjError(Format(sLastError, ['CreateProcess', GetLastError]));
  repeat
    if not GetExitCodeProcess(aProcessInformation.hProcess, aExitCode) then
      ProjError(Format(sLastError, ['GetExitCodeProcess', GetLastError]));
  until aExitCode <> Still_Active;
end;

function CheckShellExecute(Err: Integer): Integer;
resourcestring
  sShellExecuteErr = 'ShellExecute error: %d';
begin
  if Err <= 32 then
    ProjError(Format(sShellExecuteErr, [Err]));
  Result:= Err;
end;

function LocalMachine: string;
var
  Size: DWORD;
  {$IFDEF CLR}
  SB: StringBuilder;
  {$ELSE}
  S: array [0..MAX_COMPUTERNAME_LENGTH] of Char;
  {$ENDIF}
begin
  {$IFDEF CLR}
  Size:= MAX_COMPUTERNAME_LENGTH;
  SB:= StringBuilder.Create(Size);
  GetComputerName(SB, Size);
  Result:= SB.ToString;
  {$ELSE}
  Size := Sizeof(S);
  GetComputerName(S, Size);
  Result:= StrPas(S);
  {$ENDIF}
end;

function ScramblePass(const aPass: string): string;
  procedure TestC(var C: string; I: Integer; C1, C2: Char);
  begin
    if (C[I] >= C1) and (C[I] <= C2) then
      C[I]:= Chr(Ord(C2) - (Ord(C[I])-Ord(C1)));
  end;
var
  I: Integer;
begin
  Result:= '';
  for I:= 1 to Length(aPass) do
    Result:= aPass[I]+Result;
  for I:= 1 to Length(Result) do
  begin
    TestC(Result, I, 'a', 'z');
    TestC(Result, I, 'A', 'Z');
    TestC(Result, I, '0', '9');
  end;
end;

var
  S: string;
initialization
  S:= ChangeFileExt(ExpandFileName(ParamStr(0)), '.INI');
  GetCmdString('I:', clUpcase, S);
  Ini:= TMemIniFile.Create(S);  // TMemIni file to support CD-ROM RO directories
finalization
  try
    Ini.UpdateFile;   // only if Modified, but Modified property does not exist  
  except
  end;
  FreeAndNil(Ini);
end.