?? funclib.~pas
字號:
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.dtaCon1;
qCHK.Connection:=DM1.dtaCon1;
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -