{
   This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation; either
  version 2 of the License, or (at your option) any later version.

  This program 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 General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
{$D-}
unit Ufunction;

interface

uses Windows, Messages, SysUtils, Variants, Forms, Classes,
  Registry, Psapi, tlhelp32, shellapi;

  function getcurrentfilename:string;
  function GetAppDirectory:string;
  function GetSystemDir: string;
  function GetWindowsDir: string;
  function GetModuleDir: string;
  function RegisterOCX(FileName: string): Boolean;
  function UnRegisterOCX(FileName: string): Boolean;
  function GetProgramFilesDir: string;
  function ExecuteFile(filename:string; visible:boolean): Boolean;
  procedure deletefiles(dir,namespace:string);
  function GetOperatingSystem: Integer;
  procedure SplitString(str:string;var returnStr:TStringList;splitchar:char);

  function EXE_Running(FileName:string):THandle;
  function UrlDecode(const EncodedStr: String): String;
  function URLEncode(const S: string; const InQueryString: Boolean): string;

  function find_WinNTProcessID(FileName:string):integer;
  function ExtractRes(ResType, ResName, ResNewName: string): Boolean;
  function ConvertSize(value:integer):string;
  function ConvertSize2(value:integer):string;
  function timestamptodatetime(s:string):tdatetime;

  function getvalue(s1,s_w,e_w:string):string;
  function Get_File_Size2(sFileToExamine: string): integer;
  function getredirecturl(s1:string):string;
  function striphtmltag(s:string):string;
  function GetIconIndex(const APath: string; Attrs: DWORD): integer;
  procedure lockcontrol(c: THandle; lock: boolean);
  function validmemberid(s:string):boolean;
  function GetVersion(filename:string): string;

const
  { operating system (OS)constants }
  cOsUnknown = -1;
  cOsWin95 = 0;
  cOsWin98 = 1;
  cOsWin98SE = 2;
  cOsWinME = 3;
  cOsWinNT = 4;
  cOsWin2000 = 5;
  cOsXP = 6;

implementation

type
  TDllRegisterServer = function: HResult; stdcall;

function getcurrentfilename:string;
var
  szFileName: array[0..MAX_PATH] of Char;
begin
  FillChar(szFileName, SizeOf(szFileName), #0);
  GetModuleFileName(hInstance, szFileName, MAX_PATH);
  Result := szFileName;
end;

function GetAppDirectory:string;
begin
  result:=ExtractFilePath(Application.ExeName);
  if (length(result)>0) and (result[length(result)]<>'\') then
    result:=result+'\';
end;

function GetSystemDir: string;
var
  dir: array [0..MAX_PATH] of Char;
begin
  GetSystemDirectory(dir, MAX_PATH);
  Result := StrPas(dir);
  if (length(result)>0) and (result[length(result)]<>'\') then
    result:=result+'\';
end;

function GetWindowsDir: string;
var
  dir: array [0..MAX_PATH] of Char;
begin
  GetWindowsDirectory(dir, MAX_PATH);
  Result := StrPas(dir);
  if (length(result)>0) and (result[length(result)]<>'\') then
    result:=result+'\';
end;

function GetModuleDir: string;
var
  szFileName: array[0..MAX_PATH] of Char;
begin
  FillChar(szFileName, SizeOf(szFileName), #0);
  GetModuleFileName(hInstance, szFileName, MAX_PATH);
  Result := szFileName;
  Result:= sysutils.ExtractFilePath(result);  
  if (length(result)>0) and (result[length(result)]<>'\') then
    result:=result+'\';
end;

function GetProgramFilesDir: string;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion', False);
    Result := reg.ReadString('ProgramFilesDir');
  finally
    reg.Free;
  end;
  if (length(result)>0) and (result[length(result)]<>'\') then
    result:=result+'\';
end;

procedure SplitString(str:string;var returnStr:TStringList;splitchar:char);
var
 p1:integer;
 y:string;
begin

 p1:=pos(splitchar,str);
 while p1>0 do
 begin
    y:=copy(str,1,p1-1);
    returnStr.Add(y);
    delete(str,1,p1);
    p1:=pos(splitchar,str);
 end;
 if str <> '' then returnStr.Add(str);

end;

function RegisterOCX(FileName: string): Boolean;
var
  OCXHand: THandle;
  RegFunc: TDllRegisterServer;
begin
  OCXHand := LoadLibrary(PChar(FileName));
  RegFunc := GetProcAddress(OCXHand, 'DllRegisterServer');
  if @RegFunc <> nil then
    Result := RegFunc = S_OK
  else
    Result := False;
  FreeLibrary(OCXHand);
end;

function UnRegisterOCX(FileName: string): Boolean;
var
  OCXHand: THandle;
  RegFunc: TDllRegisterServer;
begin
  OCXHand := LoadLibrary(PChar(FileName));
  RegFunc := GetProcAddress(OCXHand, 'DllUnregisterServer');
  if @RegFunc <> nil then
    Result := RegFunc = S_OK
  else
    Result := False;
  FreeLibrary(OCXHand);
end;

function ExecuteFile(filename:string; visible:boolean): Boolean;
var
  SUInfo: TStartupInfo;
  ProcInfo: TProcessInformation;
  s:string;
begin
  FillChar(SUInfo, SizeOf(SUInfo), #0);
  with SUInfo do begin
     cb := SizeOf(SUInfo);
     dwFlags := STARTF_USESHOWWINDOW;
     if visible then
        wShowWindow := SW_NORMAL
     else
        wShowWindow := SW_HIDE;
//     s:=sysutils.ExtractFilePath(filename);
     createprocess(nil, PChar(filename), nil, nil, False,
        CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil,
        SUInfo, ProcInfo);
  end;
end;

procedure deletefiles(dir,namespace:string);
var
  SR: TSearchRec;
  a:string;
begin
  namespace:=lowercase(namespace);
  if FindFirst(dir+'*.*', faAnyFile, SR) = 0 then
   repeat
     if (SR.Attr <> faDirectory) and (SR.Name[1] <> '.') then begin
       a:=lowercase(sysutils.ExtractFileExt(SR.Name));
       if (namespace='*.*') or (a = namespace) then begin
          DeleteFile(dir+'\'+SR.Name);
       end;
     end;
   Until (FindNext(SR)<>0);
  FindClose(SR);
end;

function GetOperatingSystem: Integer;
var
  osVerInfo: TOSVersionInfo;
  majorVer, minorVer: Integer;
begin
  Result := cOsUnknown;
  { set operating system type flag }
  osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  if GetVersionEx(osVerInfo) then
  begin
    majorVer := osVerInfo.dwMajorVersion;
    minorVer := osVerInfo.dwMinorVersion;
    case osVerInfo.dwPlatformId of
      VER_PLATFORM_WIN32_NT: { Windows NT/2000 }
        begin
          if majorVer <= 4 then
            Result := cOsWinNT
          else if (majorVer = 5) and (minorVer = 0) then
            Result := cOsWin2000
          else if (majorVer = 5) and (minorVer = 1) then
            Result := cOsXP
          else
            Result := cOsUnknown;
        end;
      VER_PLATFORM_WIN32_WINDOWS:  { Windows 9x/ME }
        begin
          if (majorVer = 4) and (minorVer = 0) then
            Result := cOsWin95
          else if (majorVer = 4) and (minorVer = 10) then
          begin
            if osVerInfo.szCSDVersion[1] = 'A' then
              Result := cOsWin98SE
            else
              Result := cOsWin98;
          end
          else if (majorVer = 4) and (minorVer = 90) then
            Result := cOsWinME
          else
            Result := cOsUnknown;
        end;
      else
        Result := cOsUnknown;
    end;
  end
  else
    Result := cOsUnknown;
end;

///process check////
//Psapi, tlhelp32;
function CreateWin9xProcessList(FileName:string):THandle;
var
  hSnapShot: THandle;
  ProcInfo: TProcessEntry32;
  h:THandle;
begin
  result:=0;
  hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if (hSnapShot <> THandle(-1)) then 
  begin 
    ProcInfo.dwSize := SizeOf(ProcInfo);
    if (Process32First(hSnapshot, ProcInfo)) then
    begin
      if CompareText(ExtractFileName(ProcInfo.szExeFile), ExtractFileName(FileName)) = 0 then begin
         h:=OpenProcess(PROCESS_TERMINATE, False, ProcInfo.th32ProcessID);
         result:=h;
         CloseHandle(h);
         exit;
      end;

      while (Process32Next(hSnapShot, ProcInfo)) do
      if CompareText(ExtractFileName(ProcInfo.szExeFile), ExtractFileName(FileName)) = 0 then begin
         h:=OpenProcess(PROCESS_TERMINATE, False, ProcInfo.th32ProcessID);
         result:=h;
         CloseHandle(h);
         CloseHandle(hSnapShot);
         break;
      end;
    end;
    CloseHandle(hSnapShot);
  end;
end;

function CreateWinNTProcessList(FileName:string):THandle;
var
  PIDArray: array [0..1023] of DWORD;
  cb: DWORD;
  I: Integer; 
  ProcCount: Integer; 
  hMod: HMODULE; 
  hProcess: THandle;
  ModuleName: array [0..300] of Char;
  h:THandle;
begin
  result:=0;
  EnumProcesses(@PIDArray, SizeOf(PIDArray), cb);
  ProcCount := cb div SizeOf(DWORD);
  for I := 0 to ProcCount - 1 do
  begin
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or
      PROCESS_VM_READ,
      False,
      PIDArray[I]);
    if (hProcess <> 0) then
    begin
      EnumProcessModules(hProcess, @hMod, SizeOf(hMod), cb);
      GetModuleFilenameEx(hProcess, hMod, ModuleName, SizeOf(ModuleName));
      if CompareText(ModuleName, FileName) = 0 then begin
         h:=OpenProcess(PROCESS_TERMINATE, false, PIDArray[I]);
         result:=h;
         CloseHandle(h);
         CloseHandle(hProcess);
         break;
      end;
      CloseHandle(hProcess);
    end;
  end;
end;

function GetProcessList(FileName:string):THandle;
var
  ovi: TOSVersionInfo;
begin
//  if List = nil then Exit;
  result:=0;
  ovi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  GetVersionEx(ovi);
  case ovi.dwPlatformId of
    VER_PLATFORM_WIN32_WINDOWS: result:=CreateWin9xProcessList(FileName);
    VER_PLATFORM_WIN32_NT: result:=CreateWinNTProcessList(FileName);
  end
end;

function EXE_Running(FileName:string):THandle;
begin
  result:=GetProcessList(FileName);
end;

function HexToInt(HexStr: String): Int64;
var RetVar : Int64;
    i : byte;
begin
  HexStr := UpperCase(HexStr);
  if HexStr[length(HexStr)] = 'H' then
     Delete(HexStr,length(HexStr),1);
  RetVar := 0;

  for i := 1 to length(HexStr) do begin
      RetVar := RetVar shl 4;
      if HexStr[i] in ['0'..'9'] then
         RetVar := RetVar + (byte(HexStr[i]) - 48)
      else
         if HexStr[i] in ['A'..'F'] then
            RetVar := RetVar + (byte(HexStr[i]) - 55)
         else begin
            Retvar := 0;
            break;
         end;
  end;

  Result := RetVar;
end;

function UrlDecode(const EncodedStr: String): String;
var
  I: Integer;
begin
  Result := '';
  if Length(EncodedStr) > 0 then
  begin
    I := 1;
    while I <= Length(EncodedStr) do
    begin
      if EncodedStr[I] = '%' then
        begin
          Result := Result + Chr(HexToInt(EncodedStr[I+1]
                                       + EncodedStr[I+2]));
          I := Succ(Succ(I));
        end
      else if EncodedStr[I] = '+' then
        Result := Result + ' '
      else
        Result := Result + EncodedStr[I];

      I := Succ(I);
    end;
  end;
end;

function URLEncode(const S: string; const InQueryString: Boolean): string;
var
  Idx: Integer; // loops thru characters in string
begin
  Result := '';
  for Idx := 1 to Length(S) do
  begin
    case S[Idx] of
      'A'..'Z', 'a'..'z', '0'..'9', '-', '_', '.':
        Result := Result + S[Idx];
      ' ':
        if InQueryString then
          Result := Result + '+'
        else
          Result := Result + '%20';
      else
        Result := Result + '%' + SysUtils.IntToHex(Ord(S[Idx]), 2);
    end;
  end;
end;

function find_WinNTProcessID(FileName:string):integer;
var
  PIDArray: array [0..1023] of DWORD;
  cb: DWORD;
  I: Integer;
  ProcCount: Integer; 
  hMod: HMODULE; 
  hProcess: THandle;
  ModuleName: array [0..300] of Char;
begin
  result:=0;
  EnumProcesses(@PIDArray, SizeOf(PIDArray), cb);
  ProcCount := cb div SizeOf(DWORD);
  for I := 0 to ProcCount - 1 do
  begin
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or
      PROCESS_VM_READ,
      False,
      PIDArray[I]);
    if (hProcess <> 0) then
    begin
      EnumProcessModules(hProcess, @hMod, SizeOf(hMod), cb);
      GetModuleFilenameEx(hProcess, hMod, ModuleName, SizeOf(ModuleName));
      if CompareText(ModuleName, FileName) = 0 then begin
         result:=PIDArray[I];
         CloseHandle(hProcess);
         break;
      end;
      CloseHandle(hProcess);
    end;
  end;
end;

function ExtractRes(ResType, ResName, ResNewName: string): Boolean;
var
  Res: TResourceStream;
begin
  Result := False;
  Res := TResourceStream.Create(Hinstance, Resname, PChar(ResType));
  try
    Res.SavetoFile(ResNewName);
    Result := True;
  finally
    Res.Free;
  end;
end;

function ConvertSize(value:integer):string;
var
 s,d:double;
begin
try
  s:=value;
  if s > 1000000 then begin
     d := (s / 1000000);
     result:=formatfloat('##.#', d) + ' M';
  end else if s > 1000 then begin
     d := (s / 1000);
     result:=formatfloat('##.#', d) + ' Kb';
  end else begin
     result:=floattostr(s) + ' b';
  end;
except
  result:= '0 b';
end;
end;

function ConvertSize2(value:integer):string;
var
 s,d:double;
begin
try
  s:=value;
  if s > 1000 then begin
     d := (s / 1000);
     result:=formatfloat('##.#', d) + ' Kb';
  end else begin
     result:=floattostr(s) + ' b';
  end;
except
  result:= '0 b';
end;
end;

function timestamptodatetime(s:string):tdatetime;
begin
  s:=format('%s-%s-%s %s:%s',[
    copy(s,1,4),copy(s,5,2),copy(s,7,2),
    copy(s,9,2),copy(s,11,2)
    ]);
  result:=sysutils.StrToDateTime(s);
end;


 function getvalue(s1,s_w,e_w:string):string;
 var s2:string;
  p1:integer;
 begin
    result:='';
    p1:=pos(s_w,s1);
    if p1=0 then
       exit;
    s2:=copy(s1,p1+length(s_w),length(s1));
    p1:=pos(e_w,s2);
    result:=copy(s2,1,p1-1);
 end;

function Get_File_Size2(sFileToExamine: string): integer;
var
  SearchRec: TSearchRec;
  sgPath: string;
  inRetval, I1: Integer;
begin
  sgPath := ExpandFileName(sFileToExamine);
  try
    inRetval := FindFirst(ExpandFileName(sFileToExamine), faAnyFile, SearchRec);
    if inRetval = 0 then
      I1 := SearchRec.Size
    else
      I1 := -1;
  finally
    SysUtils.FindClose(SearchRec);
  end;
  Result := I1;
end;

 function getredirecturl(s1:string):string;
 var s2:string;
  p1:integer;
 begin
    result:='';
    p1:=pos('location: http',lowercase(s1));
    if p1=0 then
       exit;
    s2:=copy(s1,p1+14,length(s1));
    p1:=pos(#13,s2);
    result:='http' + copy(s2,1,p1-1);
 end;

function striphtmltag(s:string):string;
var
  p1,p2:integer;
begin
  p1:=pos('<',s);
  while p1>0 do begin
    p2:=pos('>',s);
    if p2>0 then
      delete(s,p1,p2-p1+1);
    p1:=pos('<',s);
  end;
  result:=trim(s);
end;

function GetIconIndex(const APath: string; Attrs: DWORD): integer;
var
  SFI: TSHFileInfo;
begin
  if FileExists(APath) or DirectoryExists(APath) then
    SHGetFileInfo(PChar(APath), 0, SFI, SizeOf(TSHFileInfo),
      SHGFI_SYSICONINDEX)
  else
    SHGetFileInfo(PChar(APath), Attrs, SFI, SizeOf(TSHFileInfo),
      SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
  Result := SFI.iIcon;
end;

procedure lockcontrol(c: THandle; lock: boolean);
begin
    if (c=0) then exit;
    if lock then SendMessage(c,WM_SETREDRAW,0,0)
    else begin
      SendMessage(c,WM_SETREDRAW,1,0);
      RedrawWindow(c,nil,0,
        RDW_ERASE or RDW_FRAME or RDW_INVALIDATE or RDW_ALLCHILDREN);
    end;
end;


function validmemberid(s:string):boolean;
var
  i:integer;
  c:char;
begin
  for i:=1 to length(s) do begin
    c:=s[i];
    if ((c>='0') and (c<='9')) or
      ((c>='a') and (c<='z')) or
      ((c>='A') and (c<='Z'))  then
      result:=true
    else begin
      result:=false;
      break;
    end;
  end;
end;

function GetVersion(filename:string): string;
var
  VerInfoSize: DWORD;
  VerInfo: Pointer;
  VerValueSize: DWORD;
  VerValue: PVSFixedFileInfo;
  Dummy: DWORD;
begin
  Result := '';
  VerInfoSize := GetFileVersionInfoSize(PChar(filename), Dummy);
  if VerInfoSize = 0 then Exit;
  GetMem(VerInfo, VerInfoSize);
  GetFileVersionInfo(PChar(filename), 0, VerInfoSize, VerInfo);
  VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
  with VerValue^ do
  begin
    Result := IntToStr(dwFileVersionMS shr 16);
    Result := Result + '.' + IntToStr(dwFileVersionMS and $FFFF);
    Result := Result + '.' + IntToStr(dwFileVersionLS shr 16);
    Result := Result + '.' + IntToStr(dwFileVersionLS and $FFFF);
  end;
  FreeMem(VerInfo, VerInfoSize);
end;

end.
