funclib.pas

this is sample for traders

unit FuncLib;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, DB, StdCtrls, DateUtils, StrUtils,
  ZAbstractRODataset, ZAbstractDataset,ZDataset, ZAbstractTable, ZSqlProcessor, ZSqlUpdate,
  DCPrc4, DCPcrypt2, DCPblockciphers, DCPidea, DCPsha1, frxclass ;

  type
    MainFormSize = record
    Height: Integer;
    Width: Integer;
  end;

  function EncryptText(txt: String): String;
  function DecryptText(txt: String): String;
  Function Decode_Pass(p_str: String): String;
  Function UnCode_Pass(p_str: String): String;
  Function Confirm(Msg: string):Boolean;
  Function GetPrimaryNicMacAddress(): String;
  Function GetPCName(): String;
  Function FindVolumeSerial(const Drive : PChar) : string;
  procedure SortLine(TableName: TDataSet);
  procedure SumTotal(TableName: TDataset; TableNameField: String;
  MasterTable: TDataset; MasterTableField: string; HitQty: Boolean);
  procedure RefreshRec(TableName: TDataSet);
  procedure Split(const Delimiter: Char; Input: string; const Strings: TStrings) ;
  function SecToTime(Sec: Integer): string;
  function TimeToSec(Time: String): Integer;
  function GetWinOSName:string;
  procedure Delay(msecs:integer);
  function ChkDeleteItem(itemcode: string):Boolean;
  procedure DeleteRecItem(itemcode: string);
  procedure GetMacInfo;
  procedure ShareDM;

var
  AppUserName: String; AppUserID: Integer; mnode: String; mpcname: String;
  AppName: String;
  DelRec: Integer; EditRec: Integer; AddRec: Integer;
  mTrial: Integer; mPeriode: String; mPer: Integer;
  Logo: String; TerBilang: String; Address: String;
  MFS: MainFormSize;
  Frequency:Int64; Start:Int64; Stop:Int64; Cstart:Int64;
  SQLp: TZSQLprocessor; qSQL: TZQuery;

implementation

uses DataMod1;


procedure ShareDM;
begin
  SQLp:=TZSQLprocessor.Create(nil); SQLp.Connection:=DM1.dtaCon;
  qSQL:=TZQuery.Create(nil); qSQL.Connection:=DM1.dtaCon;
end;

procedure GetMacInfo;
begin
  mpcname := GetPCName;
  mnode := GetPrimaryNicMacAddress;
end;

procedure Delay(msecs:integer);
var
  FirstTickCount:longint;
begin
  FirstTickCount:=GetTickCount;
  while ((GetTickCount-FirstTickCount) < Longint(msecs)) do
    Application.ProcessMessages;
end;

Function GetWinOSName:string;
// Added by Sylvain
var
  VwOS : OSVERSIONINFO;
begin
  try
    VwOs.dwOSVersionInfoSize:=SizeOf(VwOs);
    GetVersionEx (VwOs);
    Result := 'unknown';
    case VwOs.dwPlatformId of

      VER_PLATFORM_WIN32_NT:
        if (VwOs.dwMajorVersion = 3) then
          Result := 'Windows NT 3.51'
        else if (VwOs.dwMajorVersion = 4) then
          Result := 'Windows NT 4.0'
        else if (VwOs.dwMajorVersion = 5) AND (VwOs.dwMinorVersion= 0)  then
          Result := 'Windows 2000'
        else if (VwOs.dwMajorVersion = 5) AND (VwOs.dwMinorVersion= 1)  then
          Result := 'Windows XP';

      VER_PLATFORM_WIN32_WINDOWS:
      begin
        (*
        if (VwOs.dwMajorVersion = 4) AND (VwOs.dwMinorVersion = 0) then
          Result := 'Windows 95'
        else begin
          if (VwOs.dwMinorVersion = 10) then
            Result := 'Windows 98'
          else if (VwOs.dwMinorVersion = 90) then
            Result := 'Windows Me';
          *)
          if (VwOs.dwMajorVersion = 4) AND (VwOs.dwMinorVersion = 10) then
          begin
               if VwOs.szCSDVersion[1] = 'A' then
                 result := 'Windows 98 SE'
               else
                  result := 'Windows 98';
          end {if Version = 'A'}
          else
          if (VwOs.dwMajorVersion = 4) AND (VwOs.dwMinorVersion = 90) then
            result := 'Windows Me'
          else
            result := 'unknown';
      end;
      VER_PLATFORM_WIN32s:
        Result := 'Win32s';

    end;
      if Result<>'unknown' then ;
        Result:=Result+' (Build '+ IntToStr(VwOS.dwMajorVersion)
             + '.'+ IntToStr(VwOs.dwMinorVersion)+ ')';
  except
    Result := 'unknown';
  end;
end;

procedure Split
   (const Delimiter: Char;
    Input: string;
    const Strings: TStrings) ;
begin
   Assert(Assigned(Strings)) ;
   Strings.Clear;
   Strings.Delimiter := Delimiter;
   Strings.DelimitedText := Input;
end;

function GetPCName(): String;
var temp: array[0.. MAX_COMPUTERNAME_LENGTH + 1] of char;
    a:cardinal;
begin
  a:= MAX_COMPUTERNAME_LENGTH + 1;
  GetComputerName(temp,a);
  Result:=strpas(temp);
end;

function GetPrimaryNicMacAddress(): String;
type
TGUID=record
  A,B:word;
  D,M,S:word;
  MAC:array[1..6] of byte;
end;
var
UuidCreateFunc : function (var guid: TGUID):HResult;stdcall;
handle : THandle;
g:TGUID;
WinVer:_OSVersionInfoA;
i:integer;
begin
  WinVer.dwOSVersionInfoSize := sizeof(WinVer);
  getversionex(WinVer);

  handle := LoadLibrary('RPCRT4.DLL');
  if WinVer.dwMajorVersion >= 5 then {Windows 2000 }
   @UuidCreateFunc := GetProcAddress(Handle, 'UuidCreateSequential')
  else
   @UuidCreateFunc := GetProcAddress(Handle, 'UuidCreate') ;

  UuidCreateFunc(g);
  result:='';
  for i:=1 to 6 do
  result:=result+IntToHex(g.MAC[i],2);
end;


function EncryptText(txt: String): String;
var
  Cipher: TDCP_idea;
  KeyStr: string;
begin
  KeyStr:= 'scorpio662310';
  Cipher:= TDCP_idea.Create(nil);
  Cipher.InitStr(KeyStr,TDCP_sha1);         // initialize the cipher with a hash of the passphrase
  result:=Cipher.EncryptString(txt);
  Cipher.Burn;
  Cipher.Free;
end;

function DecryptText(txt: String): String;
var
  Cipher: TDCP_idea;
  KeyStr: string;
begin
  KeyStr:= 'scorpio662310';
  Cipher:= TDCP_idea.Create(nil);
  Cipher.InitStr(KeyStr,TDCP_sha1);         // initialize the cipher with a hash of the passphrase
  result:=Cipher.DecryptString(txt);
  Cipher.Burn;
  Cipher.Free;
end;

Function Decode_Pass(p_str: String): String;
var
  strs: String;
  pBuf: PChar;
  I, EncVal: Integer;
begin
    pBuf := PChar (p_str);
    for I := 0 to Length(p_str) - 1 do
    begin
      EncVal := ( Ord (pBuf[I]) + Ord('x') ) mod 256;
      strs := strs+Chr (EncVal);
    end;
    Result:=strs;
End;

Function UnCode_Pass(p_str: String): String;
var
  strs: String;
  pBuf: PChar;
  I, EncVal: Integer;
begin
    pBuf := PChar (p_str);
    for I := 0 to Length(p_str) - 1 do
    begin
      EncVal := ( Ord (pBuf[I]) - Ord('x') ) mod 256;
      strs := strs+Chr (EncVal);
    end;
    Result:=strs;
End;

function FindVolumeSerial(const Drive : PChar) : string;
var
   VolumeSerialNumber : DWORD;
   MaximumComponentLength : DWORD;
   FileSystemFlags : DWORD;
   SerialNumber : string;
begin
   Result:='';

   GetVolumeInformation(
        Drive,
        nil,
        0,
        @VolumeSerialNumber,
        MaximumComponentLength,
        FileSystemFlags,
        nil,
        0) ;
   SerialNumber :=
         IntToHex(HiWord(VolumeSerialNumber), 4) +
         ' - ' +
         IntToHex(LoWord(VolumeSerialNumber), 4) ;

   Result := SerialNumber;
end;

Function Confirm(Msg: string): Boolean;
begin
  Result := MessageDlg(Msg, mtConfirmation,[mbYes, mbNo], 0) = mrYes;
end;

procedure SumTotal(TableName: TDataSet; TableNameField: String;
          MasterTable: TDataSet; MasterTableField: String; HitQty: Boolean);
var
  TempTotal: Extended;
  TQty: Extended;
  PrevRecord: TBookMark;
begin
  PrevRecord := TableName.GetBookmark;
  try
    TableName.DisableControls;
    TableName.First;
    TempTotal := 0;
    TQty := 0;
    while not TableName.Eof do
    begin
      if not TableName.FieldByName(TableNameField).IsNull then
      begin
        TempTotal := TempTotal + TableName.FieldByName(TableNameField).Value;
        if HitQty then TQty := TQty + TableName.FieldByName('QTY').Value;
      end;
      TableName.Next;
    end;
    MasterTable.Edit;
    MasterTable.FieldByName(MasterTableField).Value := TempTotal;
    if HitQty then
    begin
      MasterTable.Edit;
      MasterTable.FieldByName('TQTY').Value := TQty;
    end;
  finally
    TableName.EnableControls;
    if PrevRecord <> nil then
    begin
      TableName.GotoBookmark(PrevRecord);
      TableName.FreeBookmark(PrevRecord);
    end;
  end;
end;

procedure SortLine(TableName: TDataset);
var
  Fline: integer;
begin
  Fline := 0;
  try
    TableName.DisableControls;
    TableName.First;
    while not TableName.Eof do
    begin
      Fline := Fline + 1;
      TableName.Edit;
      TableName.FieldByName('LINENO').Value := Fline;
      TableName.Next;
    end;
  finally
    TableName.EnableControls;
  end;
end;

procedure RefreshRec(TableName: TDataSet);
var
  PrevRec: TBookMark;
begin
  PrevRec := TableName.GetBookmark;
  try
  TableName.Refresh;
  finally
  TableName.GotoBookmark(PrevRec);
  end;
end;

procedure DeleteRecItem(itemcode: string);
var
  SQLp: TZSQLProcessor;
begin
  SQLp:=TZSqlProcessor.Create(nil);
  try
  SQLp.Connection:=DM1.dtaCon;
  with SQLp do
  begin
    Script.Clear;
    Script.Add('DELETE FROM item WHERE ITEMCODE=:nKODE;'+
               'DELETE FROM item_price WHERE ITEMCODE=:nKODE;');
    ParamByName('nKODE').Value:=itemcode;
    Execute;
  end;
  finally
    SQLp.Free;
  end;
end;

function ChkDeleteItem(itemcode: string):Boolean;
var
  sqltxt: String;
  SQLp: TZSQLProcessor;
  qCHK: TZReadOnlyQuery;
begin
  SQLp:=TZSqlProcessor.Create(nil);
  qCHK:=TZReadOnlyQuery.Create(nil);
  try
    SQLp.Connection:=DM1.dtaCon;
    qCHK.Connection:=DM1.dtaCon;
    with SQLp do
    begin
    Script.Clear;
    sqltxt:=('DROP TABLE IF EXISTS chkdeltmp ;'+
             'CREATE TABLE IF NOT EXISTS chkdeltmp '+
             'SELECT COUNT(*) itemcode FROM salesline WHERE ITEMCODE=:nKODE '+
             'union '+
             'select count(*) itemcode from purcline where itemcode=:nKODE '+
             'union '+
             'select count(*) itemcode from retpurcline where itemcode=:nKODE '+
             'union '+
             'select count(*) itemcode from retsalesline where itemcode=:nKODE;');
    Script.Add(sqltxt);
    ParamByName('nKODE').Value:=itemcode;
    Execute;
    end;
    with qCHK do
    begin
    Close;
    SQL.Clear;
    SQL.Add('SELECT SUM(ITEMCODE) as TOTAL FROM chkdeltmp ');
    Open;
    if (RecordCount=0) or (qCHK.FieldValues['TOTAL']=0) then Result:=True
    else Result:=False;
    end;
    finally
      SQLp.Free;qCHK.Free;
    end;
end;

function SecToTime(Sec: Integer): string;
var
   H, M, S: string;
   ZH, ZM, ZS: Integer;
begin
   ZH := Sec div 3600;
   ZM := Sec div 60 - ZH * 60;
   ZS := Sec - (ZH * 3600 + ZM * 60) ;
   H := IntToStr(ZH) ;
   M := IntToStr(ZM) ;
   S := IntToStr(ZS) ;
   Result := H + ':' + M + ':' + S;
end;

function TimeToSec(time: string): Integer;
begin
  Result:=(StrToInt(leftStr(time,2))*3600)+(StrToInt(MidStr(time,4,2))*60)+StrToInt(rightStr(time,2));
end;


end.