(*****************************************************)
(* Name: LPL_SysUtils                                *)
(* Last Revision: 03 Januar 2013                     *)
(* Version: 3.1                                      *)
(*                                                   *)
(* Copyright © 2000 - 2013 by Christian Aaangel      *)
(* and Christopher "Blert" Dilts                     *)
(*****************************************************)
(* Added in 3.1                                      *)
(* PathToApplication - Which will provide the        *)
(* application folder with trailing \                *)
(* Added in 3.0                                      *)
(* TFileOperation which will do a move/copy operation*)
(*****************************************************)

unit LPL_SysUtils;

interface

Uses
 Windows,
 Graphics,
 StdCtrls,
 ShellApi,
 Registry,
 SysUtils,
 Forms,
 ComCtrls;

Const
 fomCopy = 1;
 fomMove = 2;
 BufferSize = 4096;

type
  TOnProgressStatus = Procedure(Sender: TObject; Progress: Integer; Max: Integer) of object;
  TFileOperation = Class(TObject)
   private
    fGET_OPS: TOnProgressStatus;
    FDestFolder: String;
    FSourceFolder: String;
    FFilename: String;
    FOperationType: Byte;
    procedure SET_OPS(const Value: TOnProgressStatus);
    procedure SetDestFolder(const Value: String);
    procedure SetSourceFolder(const Value: String);
    procedure SetFilename(const Value: String);
    procedure SetOperationType(const Value: Byte);

   public
    Constructor create(OnNewProgressStatus: TOnProgressStatus); reintroduce;
    Property OnProgress: TOnProgressStatus read fGET_OPS write SET_OPS;
    Property DestFolder: String read FDestFolder write SetDestFolder;
    Property SourceFolder: String read FSourceFolder write SetSourceFolder;
    Property Filename: String read FFilename write SetFilename;
    Property OperationType: Byte read FOperationType write SetOperationType;
    Function DoOperation(Var ErrorCode: Integer; Var ErrorStr: String): Boolean;
  end;

Procedure GetIcon(IntoWhat: TIcon; Filename: String; Index: Integer);
Function GetFileReg(Const FileExtension: String; AListbox: TListbox; Var Name, Icon: String): Boolean;
Function PathToOk(APath: String): String;
Function PathFromOk(APath: String): String;
Function PathToApplication: String;
Function Win32Out(S: String): String;
Procedure ExecApp(Filename: String); Overload;
Procedure ExecApp(Filename, Parameters: String); Overload;
Function RemoveExt(FName: String): String;
Function SizetoString(Size : int64) : String;
Function BooleanToStr(B: Boolean; TrueStr: String = 'True'; FalseStr: String = 'False'): string;
Function StrToBoolean(S: String): Boolean;
Function GetFileSize(Filename: TFilename): Integer;
function IsFileInUse(FileName: TFileName): Boolean;
Function AddZero(S: String; Zeroes: Integer): String; overload;
Function AddZero(Number: Integer; Zeroes: Integer): String; overload;
function StringToCase(Str: string; StrList: array of string; CaseSensitive: Boolean = False): integer;
Function DetermineS(Value: Int64): String;


Const
 showDefault = 0;
 showNormal = 1;
 showMin = 2;
 showMax = 3;

implementation

Function PathToApplication: String;
Begin
 Result := PathToOk(ExtractFilePath(ParamStr(0)));
End;

{ TFileOperation }

constructor TFileOperation.create(OnNewProgressStatus: TOnProgressStatus);
begin
 fGet_Ops := OnNewProgressStatus;
 OperationType := 0;
end;

function TFileOperation.DoOperation(var ErrorCode: Integer;
  var ErrorStr: String): Boolean;
Var
 FromF, ToF: file of byte;
 Buffer: array[0..BufferSize - 1] of char;
 NumRead: integer;
 FileLength: longint;
 Position: Integer;

begin
 Result := true;
 ErrorCode := 0;
 ErrorStr := 'No string';

 If not fileexists(PathToOk(SourceFolder) + Filename) then begin
  Result := False;
  ErrorCode := 1;
  ErrorStr := 'Source file does not exists';
  Exit;
 end;

 If fileexists(PathToOk(DestFolder) + Filename) then begin
  Result := false;
  ErrorCode := 2;
  ErrorStr := 'File already exists';
  Exit;

 End;

 AssignFile(FromF, PathToOk(SourceFolder) + Filename);
 reset(FromF);
 AssignFile(ToF, PathToOk(DestFolder) + Filename);
 rewrite(ToF);
 FileLength := FileSize(FromF);

 Position := 0;
 NumRead := 0;

// with Progressbar1 do
// begin
//   Min := 0;
//   Max := FileLength;

 while FileLength > 0 do begin
  BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
  FileLength := FileLength - NumRead;
  BlockWrite(ToF, Buffer[0], NumRead);
  Position := Position + NumRead;
  If Assigned(OnProgress) then begin
   If (Position = 0) or (FileLength = 0) then begin
    OnProgress(Self, 1, 1); // To avoid triggering DivByZero, call as 100%
   end
    else
   begin
    OnProgress(Self, Position, FileLength);
   end;
  end;
 end;

// Ensure the GUI can report 100%
 If Assigned(OnProgress) then begin
  OnProgress(Self, 100, 100);
 end;

 CloseFile(FromF);
 CloseFile(ToF);

 If OperationType = fomMove then begin
  DeleteFile(PathToOk(SourceFolder) + Filename);
 end;

end;

procedure TFileOperation.SetDestFolder(const Value: String);
begin
  FDestFolder := Value;
end;

procedure TFileOperation.SetFilename(const Value: String);
begin
  FFilename := Value;
end;

procedure TFileOperation.SetOperationType(const Value: Byte);
begin
  FOperationType := Value;
end;

procedure TFileOperation.SetSourceFolder(const Value: String);
begin
  FSourceFolder := Value;
end;

procedure TFileOperation.SET_OPS(const Value: TOnProgressStatus);
begin
 fGet_Ops := Value;
end;

Function CountFilt(From: String; Seperator: Char = ','): Integer;
var
 Res, IC: Integer;
Begin
 Res := 0;
 If Length(From) > 0 Then begin
  Res := 1;
  For IC := 1 to length(From) do begin
   If From[IC] = Seperator Then Inc(Res);
  End;
 End;
 Result := Res;
End;

Function GetFilt(Fra: String; Nummer: Integer; Sepera: Char): String;
Var
 LastRecorded, CStart, CSlut, ATF, IC: Integer;
 Res: String;
Begin
 Res := '';
 If Length(Fra) > 0 Then begin
  CStart := 0;
  CSlut := 0;
  ATF := 1;
  LastRecorded := 0;
  If Nummer = 1 Then CStart := 1;
  For IC := 1 to length(Fra) do begin
   LastRecorded := IC;
   If Fra[IC] = Sepera Then begin
    Inc(ATF);
    If ATF = Nummer Then CStart := IC + 1;
    If ATF = Nummer + 1 Then CSlut := IC - 1;
   End;
  End;
  If (CStart <> 0) And (CSlut = 0) Then CSlut := LastRecorded;
  Res := Copy(Fra, CStart, CSlut - CStart + 1);
 End;
 Result := Res;
End;

Procedure GetIcon(IntoWhat: TIcon; Filename: String; Index: Integer);
Begin
 IntoWhat.Handle := Extracticon(IntoWhat.Handle, PChar(filename), Index);
End;

Function PathToOk(APath: String): String;
Begin
 If APath = '' Then begin
  Result := APath;
  Exit;
 End;
 If APath[length(APath)] <> '\' Then APath := APath + '\';
 Result := APath;
End;

Function GetFileReg(Const FileExtension: String; AListbox: TListbox; Var Name, Icon: String): Boolean;
Var
 WinReg: TReginifile;
 FoundAt, I2: Integer;
 S1, S2, S3: String;
 Found: Boolean;
 Res: Boolean;
begin
 Res := False;
 WinReg := TRegInifile.Create('\');
 WinReg.RootKey := HKEY_CLASSES_ROOT;
 WinReg.OpenKey('\', False);
 WinReg.GetKeyNames(AListbox.Items);
 FoundAt := -1;
 For I2 := 0 to AListbox.items.count-1 do
  If Uppercase(AListbox.items[I2]) = Uppercase(FileExtension) Then FoundAt := I2;
 If FoundAt > -1 Then begin
  Found := True;
  S1 := WinReg.ReadString(AListbox.Items[FoundAt], '', '<NOT FOUND>');
  S2 := WinReg.ReadString(S1, '', '<NOT FOUND>');
  S3 := WinReg.ReadString(S1 + '\DefaultIcon', '', '<NOT FOUND>');
  If Length(Getfilt(S3, 2, ',')) > 0 then
   If (Ord(GetFilt(S3, 2, ',')[1]) < 48) or (Ord(GetFilt(S3, 2, ',')[1]) > 57) Then Found := False;
  If Found Then begin
   Res := True;
   Name := S2;
   Icon := S3;
  End;
 End;
 AListbox.Clear;
 Result := Res;
End;

Function PathFromOk(APath: String): String;
Begin
 If APath[Length(APath)] = '\' Then APath := Copy(APath, 1, Length(APath)-1);
 Result := APath;
End;

Function Win32Out(S: String): String;
// removes shortcutmark eg. '_hello' to '& hello'
Var
 I: Integer;
Begin
 Result := '';
 For I := 1 to length(S) do begin
  If S[I] = '&' Then Result := Result + '&&'
   else Result := Result + S[I];
 End;
End;

Procedure ExecApp(Filename: String);
Begin
 ShellExecute(Application.Handle, nil, PChar(Filename), PChar(''), Pchar(Extractfilepath(Filename)), SW_SHOWNORMAL);
End;

Procedure ExecApp(Filename, Parameters: String);
Begin
 ShellExecute(Application.Handle, nil, PChar(Filename), PChar(Parameters), Pchar(Extractfilepath(Filename)), SW_SHOWNORMAL);
End;

Function RemoveExt(FName: String): String;
Var
 Res: String;
Begin
 Res := '';
 If Length(FName) > 0 Then Begin
  Res := Extractfilename(Fname);
  Res := Copy(Res, 1, Length(Res) - Length(Extractfileext(Fname)));
 End;
 Result := Res;
End;

Function SizetoString(Size : int64) : String;
Var
 S1 : string;
 Size2 : Extended;
begin
 Result := 'Too large convertion';
 Case Size of
  0 : begin
   Result := inttoStr(Size) + ' Bytes';
  end;
  1 : begin
   Result := inttoStr(Size) + ' Byte';
  end;
  2..1023 : begin
   Result := inttoStr(Size) + ' b.';
  end;
  1024..1048575 : begin
   Size2 := Size / 1024;
   S1 := Formatfloat('####.##',Size2);
   Result := s1 + ' Kb.';
  end;
  1048576..1073741823 : begin
   Size2 := Size / 1048576;
   S1 := Formatfloat('####.##',Size2);
   Result := s1 + ' Mb.';
  end;
 end;
 If Size > 1073741823 then begin
  Size2 := Size /1073741824;
  S1 := Formatfloat('####.##',Size2);
  Result := s1  + ' Gb.'
 end;
end;

Function BooleanToStr(B: Boolean; TrueStr: String = 'True'; FalseStr: String = 'False'): string;
Begin
 Result := '';
 If B Then Result := TrueStr
  else Result := FalseStr;
End;

Function StrToBoolean(S: String): Boolean;
Begin
 Result := False;
 If Uppercase(S) = 'TRUE' Then Result := true;
 If Uppercase(S) = 'FALSE' then Result := False;
end;

Function GetFileSize(Filename: TFilename): Integer;
Var
 SearchRec: TSearchRec;
Begin
 If FindFirst(Filename, faAnyFile, SearchRec) <> 0 Then begin
  Result := -1;
  Exit;
 End;
 Result := SearchRec.Size;
End;

function IsFileInUse(FileName: TFileName): Boolean;
var
  HFileRes: HFILE;
begin
  Result := False;
  if not FileExists(FileName) then Exit;
  HFileRes := CreateFile(PChar(FileName),
                         GENERIC_READ or GENERIC_WRITE,
                         0,
                         nil,
                         OPEN_EXISTING,
                         FILE_ATTRIBUTE_NORMAL,
                         0);
  Result := (HFileRes = INVALID_HANDLE_VALUE);
  if not Result then
    CloseHandle(HFileRes);
end;

Function AddZero(S: String; Zeroes: Integer): String;
Var
 I: Integer;
 Res: String;
Begin
 Res := S;
 For I := Zeroes-1 downto Length(S) do
  Res := '0' + Res;
 Result := Res;
End;

Function AddZero(Number: Integer; Zeroes: Integer): String; overload;
Begin
 AddZero(IntToStr(Number), Zeroes);
End;

function StringToCase(Str: string; StrList: array of string; CaseSensitive: Boolean = False): integer;
var
  i: integer;
begin
  result := -1;
  for i := 0 to length(StrList) - 1 do
    begin
      If CaseSensitive then begin
       If Str = Strlist[I] then begin
        Result := I;
        Break;
       end;
      end
       else
      begin
       If Uppercase(Str) = Uppercase(StrList[I]) then begin
        Result := I;
        Break;
       end;
      end;
    end;
end;

Function DetermineS(Value: Int64): String;
begin
 Result := 's';
 If Value = 1 then Result := '';
end;

end.
