公用類
来源:互联网 发布:win7怎么显示网络图标 编辑:程序博客网 时间:2024/04/28 20:40
unit PubClass;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,Clipbrd,ComObj,
Db, DBTables, ExtCtrls, StdCtrls, dbclient, ActnList, menus,Qrctrls, QuickRpt, comctrls,
dbgrids,dbctrls, NMsmtp;
type
// Date Dictionary Class
// Example
// ERPDD := TERPDD.Create(ClientDataSet1,950);
// ERPDD.GetDisplayValue(DDKey : String, Seq : string);
// ERPDD.Display_Caption(Form1);
TERPDD = class
private
{ Private declarations }
DDClientDataSet : TClientDataSet;
CodePage : Integer;
Function FindCaption(DDKey : String; CodePage, SeqNo : integer):String;
public
{ Public declarations }
Constructor Create(ClientData : TClientDataSet; Country : Integer);
Procedure Display_Caption(Form : TForm);
Function GetDisplayValue(DDKey : String; SeqNo : Integer):String;
end;
TUser = Class
protected
StartDateTime : TDateTime;
EndDateTime : TDateTime;
UserClientDataSet : TClientDataSet;
LoginCount : Integer;
public
FUserCode : String;
FUserName : String;
FSuperData : Boolean;
FUserOrgID : String;
FUserOrgCode : String;
FUserOrgName : String;
FUserRoleCode : String;
FUserPassword : String;
SMail: TNMSMTP;
FSiteName : string;
CodePage : Integer;
APServer1 : String;
APServer2 : String;
APServer3 : String;
Constructor Create(ClientDateSet : TClientDataSet);
Function CheckUser(OrgCode, UserCode, Password : String):Integer;
function GetSiteName:string;
function GetServerDate:TDate;
function GetServerDateTime:TDateTime;
Procedure Logout;
procedure Fill_Information;
{數據操作動作 By LiLiWei Date: 2005-12-03 }
Procedure OpenQu(strSQL: String);
Procedure ExecQu(strSQL: String);
{相關業務動作 By LiLiWei Date: 2005-12-03 }
Procedure GetAllSalRep(LST: TStrings); //取所有營業員
Procedure GetOrderBillStatus(LST: TStrings); //取所有訂單之狀態
end;
TERPFont = Class
public
FSize1 : Integer;
FSize2 : Integer;
FName1 : string;
FName2 : string;
Constructor Create(name1, name2 : string; Size1, Size2 :integer);
end;
TAudit = class
private
FClientDataSet : TClientDataSet;
FUserCode : String;
FProgramCode : String;
FIns, FDel, FFin, FMod, FPrt, FYes, FChk : Boolean;
public
Constructor Create(ClientData : TClientDataSet; UserCode, ProgramCode : string);
procedure WriteLog(Act : integer; Content : string);
end;
Function Encrypt(Src : string):string;
Function Decrypt(Src : string):string;
Function EncryptionEngine2(Src:String; Key:String; Encrypt : Boolean):string;
Function GetAuthority(UserCode, ProgramCode : String ; ClientData : TClientDataSet):String;
Procedure ERP_MessageI(cap, txt : string);
Function ERP_MessageQ(cap, txt : string):integer;
Function ERP_MessageQ2(cap, txt : string):Integer;
Procedure ERP_MessageE(cap, txt : string);
Procedure ERP_MessageW(cap, txt : string);
//功能: 把clientdataset中的數據導出到excel表中
//定義計算匯率函數
Function Get_CurrencyValue(SreCurrency,Dates : string; Amount : Double; PubClientData : TClientDataSet):Double;
{參數說明 SreCurrency源幣種,Dates 匯率日期,Amount 金額,PubClientData 數據源}
procedure Excel(clientdataset:tclientdataset;tiltename:string);
procedure TransferToExcel(DBGrid: TDBGrid; Save: TsaveDialog);
//獲取表或存儲過程在數據中的路徑
Function GetObjectPath(PathClientDataSet : TClientDataSet;ObjectName,TableSeq: String):String;
//把sql返回的結果add到dbgrid.PickList中
procedure AddPickList(ClientDataSet:TClientDataSet;DBGrid:TDBGrid;Seq:integer;Sql:string);
var
ERPDD: TERPDD;
CurrentUser : TUser;
ERPFont : TERPFont;
implementation
Constructor TERPFont.Create(name1, name2: string; Size1, Size2 :integer);
begin
inherited Create;
FName1 := name1;
FName2 := name2;
FSize1 := size1;
FSize2 := size2;
end;
Constructor TUser.Create(ClientDateSet : TClientDataSet);
var
str : string;
begin
inherited Create;
UserClientDataset := ClientDateSet;
LoginCount := 0;
SMail:=TNMSMTP.Create(nil);
end;
//--------add by Jerry 10/02-----//
Function Get_CurrencyValue(SreCurrency,Dates : string; Amount : Double; PubClientData : TClientDataSet):Double;
var
StrType,NativeCurrency : string;
TransRate : double;
begin
PubClientData.Close ;
PubClientData.CommandText :='select CurrencyID from SYS02050 where IsBcurrency = ' + Quotedstr('Y');
PubClientData.Open ;
if PubClientData.IsEmpty then
begin
result:= 0;
exit;
end;
NativeCurrency:=PubClientData.FieldByName('CurrencyID').AsString;
if trim(upperCase(NativeCurrency))= trim(Uppercase(SreCurrency)) then
begin
Result:=Amount;
exit;
end;
PubClientData.Close ;
PubClientData.CommandText :='select CodeID from SYS02011 where CodeKind = ' + Quotedstr('RateType');
PubClientData.Open ;
if PubClientData.IsEmpty then
begin
result:= 0;
exit;
end;
StrType:=PubClientData.FieldByName('CodeID').AsString;
if StrType='DD' then
begin
PubClientData.Close ;
PubClientData.CommandText :='select EveryTransRate from SYS02061 where dates ='
+ quotedstr(Copy(Dates,4,2))
+' and Months= '+quotedstr(Copy(Dates,1,2))
+' and Years= '+quotedstr(Copy(Dates,7,4))
+' and CurrencyID_f ='+Quotedstr(SreCurrency)
+' and CurrencyID_t ='+quotedstr(NativeCurrency);
PubClientData.Open ;
if PubClientData.IsEmpty then
begin
result:=0;
exit;
end;
TransRate:=PubClientData.fieldbyname('EveryTransRate').AsFloat;
end;
if StrType='MM' then
begin
PubClientData.Close ;
PubClientData.CommandText :='select AvgBuyTransRate from SYS02060 where'
+' Months= '+quotedstr(Copy(Dates,1,2))
+' and Years= '+quotedstr(Copy(Dates,7,4))
+' and CurrencyID_f ='+Quotedstr(SreCurrency)
+' and CurrencyID_t ='+quotedstr(NativeCurrency);
PubClientData.Open ;
if PubClientData.IsEmpty then
begin
result:=0;
exit;
end;
TransRate:=PubClientData.fieldbyname('AvgBuyTransRate').AsFloat;
end;
Result:= TransRate * Amount;
end;
Function TUser.GetServerDate:TDate;
var
strSQL: String;
FServerDate:TDate;
begin
strSQL:='select year(getdate()) Year,month(getdate()) Month,day(getdate()) Day ';
UserClientDataSet.Active := False;
UserClientDataSet.CommandText := strSQL;
UserClientDataSet.Open;
FServerDate:=EncodeDate(UserClientDataSet.FieldByName('Year').AsInteger,
UserClientDataSet.FieldByName('Month').AsInteger,
UserClientDataSet.FieldByName('Day').AsInteger);
Result:=FServerDate;
end;
Function TUser.GetServerDateTime:TDateTime;
var
strSQL: String;
FServerDateTime:TDateTime;
begin
strSQL:='select getdate() FServerDateTime';
UserClientDataSet.Active := False;
UserClientDataSet.CommandText := strSQL;
UserClientDataSet.Open;
FServerDateTime:=UserClientDataSet.FieldByName('FServerDateTime').asdatetime;
Result:=FServerDateTime;
end;
Function TUser.CheckUser(OrgCode, UserCode, Password : String):Integer;
var
SQL : String;
str : String;
Begin
UserClientDataSet.Active := False;
SQL := 'select A.*, B.OrgName from UserInfo A, OrgMain B where A.OrgID=B.OrgID and A.UserCode = '''+UserCode+''' and A.OrgCode ='''+OrgCode+'''';
UserClientDataSet.CommandText := SQL;
UserClientDataSet.Open;
UserClientDataSet.First;
if UserClientDataSet.RecordCount<1 then
begin
LoginCount := LoginCount + 1;
Result := LoginCount;
end
else
begin
str := '';
str := Decrypt(UserClientDataSet.FieldByName('Password').AsString);
if Password = str then
begin
FUserCode := UserClientDataSet.FieldByName('UserCode').AsString;
FUserName := UserClientDataSet.FieldByName('Name').AsString;
FUserOrgID := UserClientDataSet.FieldByName('OrgID').AsString;
FUserOrgCode := UserClientDataSet.FieldByName('OrgCode').AsString;
FUserOrgName := UserClientDataSet.FieldByName('OrgName').AsString;
FUserRoleCode := UserClientDataSet.FieldByName('SYSRoleCode').AsString;
FSuperData := UserClientDataSet.FieldByName('SuperData').AsBoolean;
FUserPassword := Password;
StartDateTime := Now;
Result := 0;
end
else
begin
LoginCount := LoginCount + 1;
Result := LoginCount;
end;
end;
End;
procedure TUser.Logout;
var
SQL : String;
Begin
EndDateTime := Now;
UserClientDataSet.Active := False;
SQL := 'Update UserInfo Set LatelyEnterDate='''+formatDateTime('yyyy-mm-dd hh:mm:ss',StartDateTime)+''', LatelyExitDate='''+formatDateTime('yyyy-mm-dd hh:mm:ss',EndDateTime)+''' where UserCode='''+FUserCode+'''';
UserClientDataSet.CommandText := SQL;
UserClientDataSet.Execute;
End;
Procedure ERP_MessageI(cap, txt : string);
var
Text, Caption : PChar;
begin
Text := PChar(ERPDD.GetDisplayValue(txt,0));
Caption := PChar(ERPDD.GetDisplayValue(cap,0));
Application.MessageBox(Text,Caption,mb_Ok+mb_IconInformation);
end;
Function ERP_MessageQ(cap, txt : string):Integer;
var
Text, Caption : PChar;
begin
Text := PChar(ERPDD.GetDisplayValue(txt,0));
Caption := PChar(ERPDD.GetDisplayValue(cap,0));
Result := Application.MessageBox(Text,Caption,mb_OkCancel+mb_IconQuestion);
end;
Function ERP_MessageQ2(cap, txt : string):Integer;
var
Text, Caption : PChar;
begin
Text := PChar(ERPDD.GetDisplayValue(txt,0));
Caption := PChar(ERPDD.GetDisplayValue(cap,0));
Result := Application.MessageBox(Text,Caption,mb_YesNo+mb_IconQuestion);
end;
Procedure ERP_MessageE(cap, txt : string);
var
Text, Caption : PChar;
begin
Text := PChar(ERPDD.GetDisplayValue(txt,0));
Caption := PChar(ERPDD.GetDisplayValue(cap,0));
Application.MessageBox(Text,Caption,mb_Ok+mb_IconError);
end;
Procedure ERP_MessageW(cap, txt : string);
var
Text, Caption : PChar;
begin
Text := PChar(ERPDD.GetDisplayValue(txt,0));
Caption := PChar(ERPDD.GetDisplayValue(cap,0));
Application.MessageBox(Text,Caption,mb_Ok+mb_IconWarning);
end;
Constructor TERPDD.Create(ClientData : TClientDataSet; Country : Integer);
begin
inherited Create;
DDClientDataSet := ClientData;
CodePage := Country;
if not DDClientDataSet.Active then
DDClientDataSet.Open;
end;
Function TERPDD.FindCaption(DDKey : String; CodePage, SeqNo : integer):string;
Begin
Result := '';
if DDClientDataSet.FindKey([DDKey, CodePage, SeqNo]) then
Result := DDClientDataSet.FieldByName('DisplayValue').AsString;
End;
Procedure TERPDD.Display_Caption(Form : TForm);
var
i, j,col : Integer;
str : string;
begin
str := FindCaption(Form.Caption, CodePage, Form.Tag);
if str <> '' then
Form.Caption := str;
for i:=0 to Form.ComponentCount-1 do
begin
if Form.Components[i] is TLabel then
begin
str := FindCaption((Form.Components[i] As TLabel).Caption, CodePage, (Form.Components[i] As TComponent).Tag);
if str <> '' then
(Form.Components[i] As TLabel).Caption := str;
end
else
if Form.Components[i] is TField then
begin
str := FindCaption((Form.Components[i] As TField).DisplayLabel, CodePage, (Form.Components[i] As TComponent).Tag);
if str <> '' then
(Form.Components[i] As TField).DisplayLabel := str;
end
else
if Form.Components[i] is TButton then
begin
str := FindCaption((Form.Components[i] As TButton).Caption, CodePage, (Form.Components[i] As TComponent).Tag);
if str <> '' then
(Form.Components[i] As TButton).Caption := str;
end
else
if Form.Components[i] is TAction then
begin
str := FindCaption((Form.Components[i] As TAction).Caption, CodePage, (Form.Components[i] As TAction).Tag);
if str <> '' then
(Form.Components[i] As TAction).Caption := str;
end
else
if Form.Components[i] is TMenuItem then
begin
str := (Form.Components[i] As TMenuItem).Caption;
if str[1] = '&' then
delete(str,1,1);
str := FindCaption(str, CodePage, (Form.Components[i] As TMenuItem).Tag);
if str <> '' then
(Form.Components[i] As TMenuItem).Caption := str;
end
else
if Form.Components[i] is TTabSheet then
begin
str := (Form.Components[i] As TTabSheet).Caption;
str := FindCaption(str, CodePage, (Form.Components[i] As TTabSheet).Tag);
if str <> '' then
(Form.Components[i] As TTabSheet).Caption := str;
end
else
if Form.Components[i] is TPanel then
begin
str := (Form.Components[i] As TPanel).Caption;
str := FindCaption(str, CodePage, (Form.Components[i] As TPanel).Tag);
if str <> '' then
(Form.Components[i] As TPanel).Caption := str;
end
else
if Form.Components[i] is TCheckBox then
begin
str := (Form.Components[i] As TCheckBox).Caption;
str := FindCaption(str, CodePage, (Form.Components[i] As TCheckBox).Tag);
if str <> '' then
(Form.Components[i] As TCheckBox).Caption := str;
end
else
if Form.Components[i] is TGroupBox then
begin
str := (Form.Components[i] As TGroupBox).Caption;
str := FindCaption(str, CodePage, (Form.Components[i] As TGroupBox).Tag);
if str <> '' then
(Form.Components[i] As TGroupBox).Caption := str;
end
else
if Form.Components[i] is TDBCheckBox then
begin
str := (Form.Components[i] As TDBCheckBox).Caption;
str := FindCaption(str, CodePage, (Form.Components[i] As TDBCheckBox).Tag);
if str <> '' then
(Form.Components[i] As TDBCheckBox).Caption := str;
end
else
if Form.Components[i] is TToolButton then
begin
str := (Form.Components[i] As TToolButton).Caption;
str := FindCaption(str, CodePage, (Form.Components[i] As TToolButton).Tag);
if str <> '' then
(Form.Components[i] As TToolButton).Caption := str;
end
else
if Form.Components[i] is TRadioGroup then
begin
str := (Form.Components[i] As TRadioGroup).Caption;
str := FindCaption(str, CodePage, (Form.Components[i] As TRadioGroup).Tag);
if str <> '' then
(Form.Components[i] As TRadioGroup).Caption := str;
for j:=0 to (Form.Components[i] As TRadioGroup).Items.Count-1 do
begin
end;
end
else
if Form.Components[i] is TDBRadioGroup then
begin
str := (Form.Components[i] As TDBRadioGroup).Caption;
str := FindCaption(str, CodePage, (Form.Components[i] As TDBRadioGroup).Tag);
if str <> '' then
(Form.Components[i] As TDBRadioGroup).Caption := str;
for j:=0 to (Form.Components[i] As TDBRadioGroup).Items.Count-1 do
begin
end;
end
{else //劉斌2003/07/29新增
if Form.Components[i] is TQRLabel then
begin
str := (Form.Components[i] as TQRLabel).Caption;
str := FindCaption(str, CodePage, (Form.Components[i] as TQRLabel).Tag);
if str<>'' then
(Form.Components[i] as TQRLabel).Caption := str;
end}
else
if Form.Components[i] is TQRDBText then
begin
str := (Form.Components[i] as TQRDBText).name;
str := FindCaption(str, CodePage, (Form.Components[i] as TQRDBText).Tag);
if str<>'' then
(Form.Components[i] as TQRDBText).Datafield :=trim(str);
end
else //將輸入法關閉 黎德強 2006-04-24
if Form.Components[i] is TEdit then
(Form.Components[i] As TEdit).imeMode:=imdisable
else
if Form.Components[i] is TDBEdit then
(Form.Components[i] As TDBEdit).imeMode:=imdisable
else
if Form.Components[i] is TComboBox then
(Form.Components[i] As TComboBox).imeMode:=imdisable
else
if Form.Components[i] is TDBGrid then
for col:=0 to (Form.Components[i] As TDBGrid).Columns.Count-1 do
(Form.Components[i] As TDBGrid).Columns[col].imeMode:=imdisable
else
if Form.Components[i] is TMemo then
(Form.Components[i] As TMemo).imeMode:=imdisable
else
if Form.Components[i] is TDBMemo then
(Form.Components[i] As TDBMemo).imeMode:=imdisable
end;
end;
Function TERPDD.GetDisplayValue(DDKey : String; SeqNo : Integer):String;
Begin
Result := FindCaption(DDKey,CodePage,SeqNo);
End;
Function Encrypt(Src : string):string;
var
str : String;
begin
str := EncryptionEngine2(Src,'ERP',True);
Result := str;
end;
Function Decrypt(Src : String):String;
var
str : String;
begin
str := EncryptionEngine2(Src,'ERP',False);
Result := str;
end;
Function EncryptionEngine2(Src:String; Key:String; Encrypt : Boolean):string;
var
idx :integer;
KeyLen :Integer;
KeyPos :Integer;
offset :Integer;
dest :string;
SrcPos :Integer;
SrcAsc :Integer;
TmpSrcAsc :Integer;
Range :Integer;
begin
KeyLen:=Length(Key);
if KeyLen = 0 then key:='Hawk';
KeyPos:=0;
SrcPos:=0;
SrcAsc:=0;
Range:=256;
if Encrypt then
begin
Randomize;
offset:=Random(Range);
dest:=format('%1.2x',[offset]);
for SrcPos := 1 to Length(Src) do
begin
SrcAsc:=(Ord(Src[SrcPos]) + offset) MOD 255;
if KeyPos < KeyLen then KeyPos:= KeyPos + 1 else KeyPos:=1;
SrcAsc:= SrcAsc xor Ord(Key[KeyPos]);
dest:=dest + format('%1.2x',[SrcAsc]);
offset:=SrcAsc;
end;
end
else
begin
offset:=StrToInt('$'+ copy(src,1,2));
SrcPos:=3;
repeat
SrcAsc:=StrToInt('$'+ copy(src,SrcPos,2));
if KeyPos < KeyLen Then KeyPos := KeyPos + 1 else KeyPos := 1;
TmpSrcAsc := SrcAsc xor Ord(Key[KeyPos]);
if TmpSrcAsc <= offset then
TmpSrcAsc := 255 + TmpSrcAsc - offset
else
TmpSrcAsc := TmpSrcAsc - offset;
dest := dest + chr(TmpSrcAsc);
offset:=srcAsc;
SrcPos:=SrcPos + 2;
until SrcPos >= Length(Src);
end;
Result:=Dest;
end;
Function GetAuthority(UserCode, ProgramCode : String ; ClientData : TClientDataSet):String;
var
SQL : string;
begin
SQL := 'select Authority from AuthorityDetail where SYSProgramCode='''+ProgramCode+''' and UserCode='''+UserCode+'''';
ClientData.Close;
ClientData.CommandText := SQL;
ClientData.Open;
if not ClientData.IsEmpty then
Result := ClientData.FieldByName('Authority').AsString
else
Result := '';
end;
function TUser.GetSiteName: string;
begin
Result := FSiteName;
end;
procedure TUser.Fill_Information;
var
SQL : String;
str : String;
Begin
UserClientDataSet.Active := False;
SQL := 'select A.*, B.OrgName from UserInfo A, OrgMain B where A.OrgID=B.OrgID and A.UserCode = '''+FUserCode+'''';
UserClientDataSet.CommandText := SQL;
UserClientDataSet.Open;
UserClientDataSet.First;
FUserName := UserClientDataSet.FieldByName('Name').AsString;
FUserOrgID := UserClientDataSet.FieldByName('OrgID').AsString;
FUserOrgCode := UserClientDataSet.FieldByName('OrgCode').AsString;
FUserOrgName := UserClientDataSet.FieldByName('OrgName').AsString;
FUserRoleCode := UserClientDataSet.FieldByName('SYSRoleCode').AsString;
FSuperData := UserClientDataSet.FieldByName('SuperData').AsBoolean;
StartDateTime := Now;
End;
{ TAudit }
constructor TAudit.Create(ClientData: TClientDataSet; UserCode,
ProgramCode: string);
begin
FClientDataSet := ClientData;
FUserCode := UserCode;
FProgramCode := ProgramCode;
with FClientDataSet do
begin
Close;
CommandText := 'select * from ProgramAudit where ProgramCode='''+FProgramCode+'''';
Open;
if not IsEmpty then
begin
if FieldByName('Ins').asboolean then
FIns := True
else
FIns := False;
if FieldByName('Mod').asboolean then
FMod := True
else
FMod := False;
if FieldByName('Prt').asboolean then
FPrt := True
else
FPrt := False;
if FieldByName('Del').asboolean then
FDel := True
else
FDel := False;
if FieldByName('Fin').asboolean then
FFin := True
else
FFin := False;
if FieldByName('Yes').asboolean then
FYes := True
else
FYes := False;
if FieldByName('Chk').asboolean then
FChk := True
else
FChk := False;
end
else
begin
FIns := False;
FDel := False;
FFin := False;
FChk := False;
FPrt := False;
FMod := False;
FYes := False;
end;
end;
end;
procedure TAudit.WriteLog(Act: integer; Content: string);
var
sql : string;
begin
with FClientDataSet do
begin
if ((Act = 1) and FIns) or ((Act = 2) and FDel) or ((Act = 3) and FFin) or((Act = 4) and FMod) or ((Act = 5) and FPrt) then
begin
close;
sql := 'INSERT INTO AuditLog (ProgramCode, ActionType, ActionCon, ActionTime, UserCode) VALUES ('''+FProgramCode
+''','+inttostr(Act)+','''+Content+''', GETDATE() ,'''+FuserCode+''' )';
CommandText := sql;
Execute;
end
else
if ((Act = 6) and FYes) or ((Act = 7) and FChk) then
begin
close;
CommandText := 'INSERT INTO AuditLog (ProgramCode, ActionType, ActionCon, ActionTime, UserCode) VALUES ('''+FProgramCode
+''','+inttostr(Act)+','''+Content+''', GETDATE() ,'''+FuserCode+''' )';
Execute;
end;
end;
end;
procedure Excel(clientdataset:tclientdataset;tiltename:string);
var
MSExcel,sheet:Variant;
i,j,T,H:Integer;
vstr:string;
begin
vstr:='';
if clientdataset.active then
begin
with clientdataset do
begin
DisableControls;
j:=RecordCount;
H:=FieldCount;
First;
for i:=0 to H-1 DO
vstr:=vstr+vartostr(FieldDefs.Items[i].DisplayName)+char(9);
vstr:=vstr+char(13);
for i:=1 to j do
begin
for t:=0 to H-1 do
begin
vstr:=vstr+vartostr(Fields[t].value)+char(9);
end;
vstr:=vstr+char(13);
clientdataset.Next;
end;
EnableControls;
clipboard.Clear;
clipboard.Open;
clipboard.astext:=vstr;
clipboard.Close;
MSExcel:=CreateoleObject('Excel.Application');
MSExcel.Workbooks.Add(-4167);
MSEXcel.workbooks[1].worksheets[1].name:=tiltename;
sheet:=MSEXcel.workbooks[1].worksheets[1];
sheet.paste;
MSExcel.Visible:=true;
end;
end;
end;
procedure TUser.GetAllSalRep(LST: TStrings);
var
strSQL: String;
begin
strSQL:='select rtrim(SalesRepID)+''@''+ltrim(ChineseName) SalesRep from SAL01050 ';
OpenQu(strSQL);
LST.Clear;
if UserClientDataset.IsEmpty then exit;
LST.Add('');
UserClientDataset.First;
while not UserClientDataset.Eof do
begin
LST.Add(UserClientDataset.FieldByName('SalesRep').Asstring);
UserClientDataset.Next;
end;
end;
procedure TUser.ExecQu(strSQL: String);
begin
UserClientDataset.Close;
UserClientDataset.CommandText:=strSQL;
UserClientDataset.Execute;
end;
procedure TUser.OpenQu(strSQL: String);
begin
UserClientDataset.Close;
UserClientDataset.CommandText:=strSQL;
UserClientDataset.Open;
end;
procedure TUser.GetOrderBillStatus(LST: TStrings);
var
strSQL: String;
begin
strSQL:='select rtrim(CodeID)+''-''+ltrim(CodeDesc) BillStatus from SYS02011(nolock) where CodeKind =''BillStatusID'' '
+'and charindex(Ltrim(rtrim(CodeID)),''ACDEZ'')>0 ';
OpenQu(strSQL);
LST.Clear;
if UserClientDataset.IsEmpty then exit;
LST.Add('');
UserClientDataset.First;
while not UserClientDataset.Eof do
begin
LST.Add(UserClientDataset.FieldByName('BillStatus').Asstring);
UserClientDataset.Next;
end;
end;
procedure TransferToExcel(DBGrid: TDBGrid; Save: TsaveDialog);
var
i: integer;
fieldStr: string;
i_file: TextFile;
begin
if Save.Execute then
begin
AssignFile(i_file, Save.FileName);
Rewrite(i_file);
with TDatasource(dbGrid.Datasource).Dataset do
begin
DisableControls;
for i := 0 to dbGrid.columns.count - 1 do
begin
if dbGrid.columns[i].Visible = true then
write(i_file, dbGrid.columns[i].title.caption + Char(9));
end;
writeln(i_file);
first;
while not Eof do
begin
for i := 0 to dbGrid.columns.count - 1 do
begin
if FieldByName(dbGrid.columns[i].fieldname).DataType = ftDateTime then
begin
fieldStr := '';
if not FieldByName(dbGrid.columns[i].fieldname).isnull then
fieldStr := fieldStr + dateTimetostr(FieldByName(dbGrid.columns[i].fieldname).asdatetime);
end
else if FieldByName(dbGrid.columns[i].fieldname).DataType = ftInteger then
begin
fieldStr := '';
if not FieldByName(dbGrid.columns[i].fieldname).isnull then
fieldStr := fieldStr + inttostr(FieldByName(dbGrid.columns[i].fieldname).asinteger);
end
else if FieldByName(dbGrid.columns[i].fieldname).DataType = ftsmallint then
begin
fieldStr := '';
if not FieldByName(dbGrid.columns[i].fieldname).isnull then
fieldStr := fieldStr + inttostr(FieldByName(dbGrid.columns[i].fieldname).asinteger);
end
else if FieldByName(dbGrid.columns[i].fieldname).DataType = ftString then
begin
fieldStr := '';
if not FieldByName(dbGrid.columns[i].fieldname).isnull then
begin
if LowerCase(dbGrid.columns[i].fieldname) = LowerCase('ConvertNumber') then
fieldStr := fieldStr + FieldByName(dbGrid.columns[i].fieldname).asstring
else
fieldStr := fieldStr + FieldByName(dbGrid.columns[i].fieldname).asstring;
end;
end
else if FieldByName(dbGrid.columns[i].fieldname).DataType = ftfloat then
begin
fieldStr := '';
if not FieldByName(dbGrid.columns[i].fieldname).isnull then
fieldStr := fieldStr + FieldByName(dbGrid.columns[i].fieldname).asstring;
end
else
begin
fieldStr := '';
if not FieldByName(dbGrid.columns[i].fieldname).isnull then
fieldStr := fieldStr + FieldByName(dbGrid.columns[i].fieldname).asstring;
end ;
if dbGrid.columns[i].Visible = true then
write(i_file, fieldStr + Char(9));
end;
writeln(i_file);
next;
end;
EnableControls;
Closefile(i_file);
Showmessage('存檔完成');
end;
end;
end;
Function GetObjectPath(PathClientDataSet : TClientDataSet;ObjectName,TableSeq: String):String;
var
SQL : string;
begin
SQL:='select rtrim(DBName)+''.''+rtrim(isnull(Owner,''DBO''))+''.''+ObjectName from ObjectPath where ObjectName='''+ObjectName+'''';
PathClientDataSet.Close;
PathClientDataSet.CommandText := SQL;
PathClientDataSet.Open;
if not PathClientDataSet.IsEmpty then
Result := PathClientDataSet.fields[0].AsString+' '+TableSeq
else
Result := ObjectName+' '+TableSeq;
end;
procedure AddPickList(ClientDataSet:TClientDataSet;DBGrid:TDBGrid;Seq:integer;Sql:string);
var
str:string;
begin
{ with ClientDataSet do
begin
close;
commandtext:=Sql;
open;
DBGrid.Columns[Seq].PickList.Clear;
first;
while not eof do
begin
str:=fields[0].AsString;
Column.PickList.Add(str);
next;
end;
end;
}end;
end.
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,Clipbrd,ComObj,
Db, DBTables, ExtCtrls, StdCtrls, dbclient, ActnList, menus,Qrctrls, QuickRpt, comctrls,
dbgrids,dbctrls, NMsmtp;
type
// Date Dictionary Class
// Example
// ERPDD := TERPDD.Create(ClientDataSet1,950);
// ERPDD.GetDisplayValue(DDKey : String, Seq : string);
// ERPDD.Display_Caption(Form1);
TERPDD = class
private
{ Private declarations }
DDClientDataSet : TClientDataSet;
CodePage : Integer;
Function FindCaption(DDKey : String; CodePage, SeqNo : integer):String;
public
{ Public declarations }
Constructor Create(ClientData : TClientDataSet; Country : Integer);
Procedure Display_Caption(Form : TForm);
Function GetDisplayValue(DDKey : String; SeqNo : Integer):String;
end;
TUser = Class
protected
StartDateTime : TDateTime;
EndDateTime : TDateTime;
UserClientDataSet : TClientDataSet;
LoginCount : Integer;
public
FUserCode : String;
FUserName : String;
FSuperData : Boolean;
FUserOrgID : String;
FUserOrgCode : String;
FUserOrgName : String;
FUserRoleCode : String;
FUserPassword : String;
SMail: TNMSMTP;
FSiteName : string;
CodePage : Integer;
APServer1 : String;
APServer2 : String;
APServer3 : String;
Constructor Create(ClientDateSet : TClientDataSet);
Function CheckUser(OrgCode, UserCode, Password : String):Integer;
function GetSiteName:string;
function GetServerDate:TDate;
function GetServerDateTime:TDateTime;
Procedure Logout;
procedure Fill_Information;
{數據操作動作 By LiLiWei Date: 2005-12-03 }
Procedure OpenQu(strSQL: String);
Procedure ExecQu(strSQL: String);
{相關業務動作 By LiLiWei Date: 2005-12-03 }
Procedure GetAllSalRep(LST: TStrings); //取所有營業員
Procedure GetOrderBillStatus(LST: TStrings); //取所有訂單之狀態
end;
TERPFont = Class
public
FSize1 : Integer;
FSize2 : Integer;
FName1 : string;
FName2 : string;
Constructor Create(name1, name2 : string; Size1, Size2 :integer);
end;
TAudit = class
private
FClientDataSet : TClientDataSet;
FUserCode : String;
FProgramCode : String;
FIns, FDel, FFin, FMod, FPrt, FYes, FChk : Boolean;
public
Constructor Create(ClientData : TClientDataSet; UserCode, ProgramCode : string);
procedure WriteLog(Act : integer; Content : string);
end;
Function Encrypt(Src : string):string;
Function Decrypt(Src : string):string;
Function EncryptionEngine2(Src:String; Key:String; Encrypt : Boolean):string;
Function GetAuthority(UserCode, ProgramCode : String ; ClientData : TClientDataSet):String;
Procedure ERP_MessageI(cap, txt : string);
Function ERP_MessageQ(cap, txt : string):integer;
Function ERP_MessageQ2(cap, txt : string):Integer;
Procedure ERP_MessageE(cap, txt : string);
Procedure ERP_MessageW(cap, txt : string);
//功能: 把clientdataset中的數據導出到excel表中
//定義計算匯率函數
Function Get_CurrencyValue(SreCurrency,Dates : string; Amount : Double; PubClientData : TClientDataSet):Double;
{參數說明 SreCurrency源幣種,Dates 匯率日期,Amount 金額,PubClientData 數據源}
procedure Excel(clientdataset:tclientdataset;tiltename:string);
procedure TransferToExcel(DBGrid: TDBGrid; Save: TsaveDialog);
//獲取表或存儲過程在數據中的路徑
Function GetObjectPath(PathClientDataSet : TClientDataSet;ObjectName,TableSeq: String):String;
//把sql返回的結果add到dbgrid.PickList中
procedure AddPickList(ClientDataSet:TClientDataSet;DBGrid:TDBGrid;Seq:integer;Sql:string);
var
ERPDD: TERPDD;
CurrentUser : TUser;
ERPFont : TERPFont;
implementation
Constructor TERPFont.Create(name1, name2: string; Size1, Size2 :integer);
begin
inherited Create;
FName1 := name1;
FName2 := name2;
FSize1 := size1;
FSize2 := size2;
end;
Constructor TUser.Create(ClientDateSet : TClientDataSet);
var
str : string;
begin
inherited Create;
UserClientDataset := ClientDateSet;
LoginCount := 0;
SMail:=TNMSMTP.Create(nil);
end;
//--------add by Jerry 10/02-----//
Function Get_CurrencyValue(SreCurrency,Dates : string; Amount : Double; PubClientData : TClientDataSet):Double;
var
StrType,NativeCurrency : string;
TransRate : double;
begin
PubClientData.Close ;
PubClientData.CommandText :='select CurrencyID from SYS02050 where IsBcurrency = ' + Quotedstr('Y');
PubClientData.Open ;
if PubClientData.IsEmpty then
begin
result:= 0;
exit;
end;
NativeCurrency:=PubClientData.FieldByName('CurrencyID').AsString;
if trim(upperCase(NativeCurrency))= trim(Uppercase(SreCurrency)) then
begin
Result:=Amount;
exit;
end;
PubClientData.Close ;
PubClientData.CommandText :='select CodeID from SYS02011 where CodeKind = ' + Quotedstr('RateType');
PubClientData.Open ;
if PubClientData.IsEmpty then
begin
result:= 0;
exit;
end;
StrType:=PubClientData.FieldByName('CodeID').AsString;
if StrType='DD' then
begin
PubClientData.Close ;
PubClientData.CommandText :='select EveryTransRate from SYS02061 where dates ='
+ quotedstr(Copy(Dates,4,2))
+' and Months= '+quotedstr(Copy(Dates,1,2))
+' and Years= '+quotedstr(Copy(Dates,7,4))
+' and CurrencyID_f ='+Quotedstr(SreCurrency)
+' and CurrencyID_t ='+quotedstr(NativeCurrency);
PubClientData.Open ;
if PubClientData.IsEmpty then
begin
result:=0;
exit;
end;
TransRate:=PubClientData.fieldbyname('EveryTransRate').AsFloat;
end;
if StrType='MM' then
begin
PubClientData.Close ;
PubClientData.CommandText :='select AvgBuyTransRate from SYS02060 where'
+' Months= '+quotedstr(Copy(Dates,1,2))
+' and Years= '+quotedstr(Copy(Dates,7,4))
+' and CurrencyID_f ='+Quotedstr(SreCurrency)
+' and CurrencyID_t ='+quotedstr(NativeCurrency);
PubClientData.Open ;
if PubClientData.IsEmpty then
begin
result:=0;
exit;
end;
TransRate:=PubClientData.fieldbyname('AvgBuyTransRate').AsFloat;
end;
Result:= TransRate * Amount;
end;
Function TUser.GetServerDate:TDate;
var
strSQL: String;
FServerDate:TDate;
begin
strSQL:='select year(getdate()) Year,month(getdate()) Month,day(getdate()) Day ';
UserClientDataSet.Active := False;
UserClientDataSet.CommandText := strSQL;
UserClientDataSet.Open;
FServerDate:=EncodeDate(UserClientDataSet.FieldByName('Year').AsInteger,
UserClientDataSet.FieldByName('Month').AsInteger,
UserClientDataSet.FieldByName('Day').AsInteger);
Result:=FServerDate;
end;
Function TUser.GetServerDateTime:TDateTime;
var
strSQL: String;
FServerDateTime:TDateTime;
begin
strSQL:='select getdate() FServerDateTime';
UserClientDataSet.Active := False;
UserClientDataSet.CommandText := strSQL;
UserClientDataSet.Open;
FServerDateTime:=UserClientDataSet.FieldByName('FServerDateTime').asdatetime;
Result:=FServerDateTime;
end;
Function TUser.CheckUser(OrgCode, UserCode, Password : String):Integer;
var
SQL : String;
str : String;
Begin
UserClientDataSet.Active := False;
SQL := 'select A.*, B.OrgName from UserInfo A, OrgMain B where A.OrgID=B.OrgID and A.UserCode = '''+UserCode+''' and A.OrgCode ='''+OrgCode+'''';
UserClientDataSet.CommandText := SQL;
UserClientDataSet.Open;
UserClientDataSet.First;
if UserClientDataSet.RecordCount<1 then
begin
LoginCount := LoginCount + 1;
Result := LoginCount;
end
else
begin
str := '';
str := Decrypt(UserClientDataSet.FieldByName('Password').AsString);
if Password = str then
begin
FUserCode := UserClientDataSet.FieldByName('UserCode').AsString;
FUserName := UserClientDataSet.FieldByName('Name').AsString;
FUserOrgID := UserClientDataSet.FieldByName('OrgID').AsString;
FUserOrgCode := UserClientDataSet.FieldByName('OrgCode').AsString;
FUserOrgName := UserClientDataSet.FieldByName('OrgName').AsString;
FUserRoleCode := UserClientDataSet.FieldByName('SYSRoleCode').AsString;
FSuperData := UserClientDataSet.FieldByName('SuperData').AsBoolean;
FUserPassword := Password;
StartDateTime := Now;
Result := 0;
end
else
begin
LoginCount := LoginCount + 1;
Result := LoginCount;
end;
end;
End;
procedure TUser.Logout;
var
SQL : String;
Begin
EndDateTime := Now;
UserClientDataSet.Active := False;
SQL := 'Update UserInfo Set LatelyEnterDate='''+formatDateTime('yyyy-mm-dd hh:mm:ss',StartDateTime)+''', LatelyExitDate='''+formatDateTime('yyyy-mm-dd hh:mm:ss',EndDateTime)+''' where UserCode='''+FUserCode+'''';
UserClientDataSet.CommandText := SQL;
UserClientDataSet.Execute;
End;
Procedure ERP_MessageI(cap, txt : string);
var
Text, Caption : PChar;
begin
Text := PChar(ERPDD.GetDisplayValue(txt,0));
Caption := PChar(ERPDD.GetDisplayValue(cap,0));
Application.MessageBox(Text,Caption,mb_Ok+mb_IconInformation);
end;
Function ERP_MessageQ(cap, txt : string):Integer;
var
Text, Caption : PChar;
begin
Text := PChar(ERPDD.GetDisplayValue(txt,0));
Caption := PChar(ERPDD.GetDisplayValue(cap,0));
Result := Application.MessageBox(Text,Caption,mb_OkCancel+mb_IconQuestion);
end;
Function ERP_MessageQ2(cap, txt : string):Integer;
var
Text, Caption : PChar;
begin
Text := PChar(ERPDD.GetDisplayValue(txt,0));
Caption := PChar(ERPDD.GetDisplayValue(cap,0));
Result := Application.MessageBox(Text,Caption,mb_YesNo+mb_IconQuestion);
end;
Procedure ERP_MessageE(cap, txt : string);
var
Text, Caption : PChar;
begin
Text := PChar(ERPDD.GetDisplayValue(txt,0));
Caption := PChar(ERPDD.GetDisplayValue(cap,0));
Application.MessageBox(Text,Caption,mb_Ok+mb_IconError);
end;
Procedure ERP_MessageW(cap, txt : string);
var
Text, Caption : PChar;
begin
Text := PChar(ERPDD.GetDisplayValue(txt,0));
Caption := PChar(ERPDD.GetDisplayValue(cap,0));
Application.MessageBox(Text,Caption,mb_Ok+mb_IconWarning);
end;
Constructor TERPDD.Create(ClientData : TClientDataSet; Country : Integer);
begin
inherited Create;
DDClientDataSet := ClientData;
CodePage := Country;
if not DDClientDataSet.Active then
DDClientDataSet.Open;
end;
Function TERPDD.FindCaption(DDKey : String; CodePage, SeqNo : integer):string;
Begin
Result := '';
if DDClientDataSet.FindKey([DDKey, CodePage, SeqNo]) then
Result := DDClientDataSet.FieldByName('DisplayValue').AsString;
End;
Procedure TERPDD.Display_Caption(Form : TForm);
var
i, j,col : Integer;
str : string;
begin
str := FindCaption(Form.Caption, CodePage, Form.Tag);
if str <> '' then
Form.Caption := str;
for i:=0 to Form.ComponentCount-1 do
begin
if Form.Components[i] is TLabel then
begin
str := FindCaption((Form.Components[i] As TLabel).Caption, CodePage, (Form.Components[i] As TComponent).Tag);
if str <> '' then
(Form.Components[i] As TLabel).Caption := str;
end
else
if Form.Components[i] is TField then
begin
str := FindCaption((Form.Components[i] As TField).DisplayLabel, CodePage, (Form.Components[i] As TComponent).Tag);
if str <> '' then
(Form.Components[i] As TField).DisplayLabel := str;
end
else
if Form.Components[i] is TButton then
begin
str := FindCaption((Form.Components[i] As TButton).Caption, CodePage, (Form.Components[i] As TComponent).Tag);
if str <> '' then
(Form.Components[i] As TButton).Caption := str;
end
else
if Form.Components[i] is TAction then
begin
str := FindCaption((Form.Components[i] As TAction).Caption, CodePage, (Form.Components[i] As TAction).Tag);
if str <> '' then
(Form.Components[i] As TAction).Caption := str;
end
else
if Form.Components[i] is TMenuItem then
begin
str := (Form.Components[i] As TMenuItem).Caption;
if str[1] = '&' then
delete(str,1,1);
str := FindCaption(str, CodePage, (Form.Components[i] As TMenuItem).Tag);
if str <> '' then
(Form.Components[i] As TMenuItem).Caption := str;
end
else
if Form.Components[i] is TTabSheet then
begin
str := (Form.Components[i] As TTabSheet).Caption;
str := FindCaption(str, CodePage, (Form.Components[i] As TTabSheet).Tag);
if str <> '' then
(Form.Components[i] As TTabSheet).Caption := str;
end
else
if Form.Components[i] is TPanel then
begin
str := (Form.Components[i] As TPanel).Caption;
str := FindCaption(str, CodePage, (Form.Components[i] As TPanel).Tag);
if str <> '' then
(Form.Components[i] As TPanel).Caption := str;
end
else
if Form.Components[i] is TCheckBox then
begin
str := (Form.Components[i] As TCheckBox).Caption;
str := FindCaption(str, CodePage, (Form.Components[i] As TCheckBox).Tag);
if str <> '' then
(Form.Components[i] As TCheckBox).Caption := str;
end
else
if Form.Components[i] is TGroupBox then
begin
str := (Form.Components[i] As TGroupBox).Caption;
str := FindCaption(str, CodePage, (Form.Components[i] As TGroupBox).Tag);
if str <> '' then
(Form.Components[i] As TGroupBox).Caption := str;
end
else
if Form.Components[i] is TDBCheckBox then
begin
str := (Form.Components[i] As TDBCheckBox).Caption;
str := FindCaption(str, CodePage, (Form.Components[i] As TDBCheckBox).Tag);
if str <> '' then
(Form.Components[i] As TDBCheckBox).Caption := str;
end
else
if Form.Components[i] is TToolButton then
begin
str := (Form.Components[i] As TToolButton).Caption;
str := FindCaption(str, CodePage, (Form.Components[i] As TToolButton).Tag);
if str <> '' then
(Form.Components[i] As TToolButton).Caption := str;
end
else
if Form.Components[i] is TRadioGroup then
begin
str := (Form.Components[i] As TRadioGroup).Caption;
str := FindCaption(str, CodePage, (Form.Components[i] As TRadioGroup).Tag);
if str <> '' then
(Form.Components[i] As TRadioGroup).Caption := str;
for j:=0 to (Form.Components[i] As TRadioGroup).Items.Count-1 do
begin
end;
end
else
if Form.Components[i] is TDBRadioGroup then
begin
str := (Form.Components[i] As TDBRadioGroup).Caption;
str := FindCaption(str, CodePage, (Form.Components[i] As TDBRadioGroup).Tag);
if str <> '' then
(Form.Components[i] As TDBRadioGroup).Caption := str;
for j:=0 to (Form.Components[i] As TDBRadioGroup).Items.Count-1 do
begin
end;
end
{else //劉斌2003/07/29新增
if Form.Components[i] is TQRLabel then
begin
str := (Form.Components[i] as TQRLabel).Caption;
str := FindCaption(str, CodePage, (Form.Components[i] as TQRLabel).Tag);
if str<>'' then
(Form.Components[i] as TQRLabel).Caption := str;
end}
else
if Form.Components[i] is TQRDBText then
begin
str := (Form.Components[i] as TQRDBText).name;
str := FindCaption(str, CodePage, (Form.Components[i] as TQRDBText).Tag);
if str<>'' then
(Form.Components[i] as TQRDBText).Datafield :=trim(str);
end
else //將輸入法關閉 黎德強 2006-04-24
if Form.Components[i] is TEdit then
(Form.Components[i] As TEdit).imeMode:=imdisable
else
if Form.Components[i] is TDBEdit then
(Form.Components[i] As TDBEdit).imeMode:=imdisable
else
if Form.Components[i] is TComboBox then
(Form.Components[i] As TComboBox).imeMode:=imdisable
else
if Form.Components[i] is TDBGrid then
for col:=0 to (Form.Components[i] As TDBGrid).Columns.Count-1 do
(Form.Components[i] As TDBGrid).Columns[col].imeMode:=imdisable
else
if Form.Components[i] is TMemo then
(Form.Components[i] As TMemo).imeMode:=imdisable
else
if Form.Components[i] is TDBMemo then
(Form.Components[i] As TDBMemo).imeMode:=imdisable
end;
end;
Function TERPDD.GetDisplayValue(DDKey : String; SeqNo : Integer):String;
Begin
Result := FindCaption(DDKey,CodePage,SeqNo);
End;
Function Encrypt(Src : string):string;
var
str : String;
begin
str := EncryptionEngine2(Src,'ERP',True);
Result := str;
end;
Function Decrypt(Src : String):String;
var
str : String;
begin
str := EncryptionEngine2(Src,'ERP',False);
Result := str;
end;
Function EncryptionEngine2(Src:String; Key:String; Encrypt : Boolean):string;
var
idx :integer;
KeyLen :Integer;
KeyPos :Integer;
offset :Integer;
dest :string;
SrcPos :Integer;
SrcAsc :Integer;
TmpSrcAsc :Integer;
Range :Integer;
begin
KeyLen:=Length(Key);
if KeyLen = 0 then key:='Hawk';
KeyPos:=0;
SrcPos:=0;
SrcAsc:=0;
Range:=256;
if Encrypt then
begin
Randomize;
offset:=Random(Range);
dest:=format('%1.2x',[offset]);
for SrcPos := 1 to Length(Src) do
begin
SrcAsc:=(Ord(Src[SrcPos]) + offset) MOD 255;
if KeyPos < KeyLen then KeyPos:= KeyPos + 1 else KeyPos:=1;
SrcAsc:= SrcAsc xor Ord(Key[KeyPos]);
dest:=dest + format('%1.2x',[SrcAsc]);
offset:=SrcAsc;
end;
end
else
begin
offset:=StrToInt('$'+ copy(src,1,2));
SrcPos:=3;
repeat
SrcAsc:=StrToInt('$'+ copy(src,SrcPos,2));
if KeyPos < KeyLen Then KeyPos := KeyPos + 1 else KeyPos := 1;
TmpSrcAsc := SrcAsc xor Ord(Key[KeyPos]);
if TmpSrcAsc <= offset then
TmpSrcAsc := 255 + TmpSrcAsc - offset
else
TmpSrcAsc := TmpSrcAsc - offset;
dest := dest + chr(TmpSrcAsc);
offset:=srcAsc;
SrcPos:=SrcPos + 2;
until SrcPos >= Length(Src);
end;
Result:=Dest;
end;
Function GetAuthority(UserCode, ProgramCode : String ; ClientData : TClientDataSet):String;
var
SQL : string;
begin
SQL := 'select Authority from AuthorityDetail where SYSProgramCode='''+ProgramCode+''' and UserCode='''+UserCode+'''';
ClientData.Close;
ClientData.CommandText := SQL;
ClientData.Open;
if not ClientData.IsEmpty then
Result := ClientData.FieldByName('Authority').AsString
else
Result := '';
end;
function TUser.GetSiteName: string;
begin
Result := FSiteName;
end;
procedure TUser.Fill_Information;
var
SQL : String;
str : String;
Begin
UserClientDataSet.Active := False;
SQL := 'select A.*, B.OrgName from UserInfo A, OrgMain B where A.OrgID=B.OrgID and A.UserCode = '''+FUserCode+'''';
UserClientDataSet.CommandText := SQL;
UserClientDataSet.Open;
UserClientDataSet.First;
FUserName := UserClientDataSet.FieldByName('Name').AsString;
FUserOrgID := UserClientDataSet.FieldByName('OrgID').AsString;
FUserOrgCode := UserClientDataSet.FieldByName('OrgCode').AsString;
FUserOrgName := UserClientDataSet.FieldByName('OrgName').AsString;
FUserRoleCode := UserClientDataSet.FieldByName('SYSRoleCode').AsString;
FSuperData := UserClientDataSet.FieldByName('SuperData').AsBoolean;
StartDateTime := Now;
End;
{ TAudit }
constructor TAudit.Create(ClientData: TClientDataSet; UserCode,
ProgramCode: string);
begin
FClientDataSet := ClientData;
FUserCode := UserCode;
FProgramCode := ProgramCode;
with FClientDataSet do
begin
Close;
CommandText := 'select * from ProgramAudit where ProgramCode='''+FProgramCode+'''';
Open;
if not IsEmpty then
begin
if FieldByName('Ins').asboolean then
FIns := True
else
FIns := False;
if FieldByName('Mod').asboolean then
FMod := True
else
FMod := False;
if FieldByName('Prt').asboolean then
FPrt := True
else
FPrt := False;
if FieldByName('Del').asboolean then
FDel := True
else
FDel := False;
if FieldByName('Fin').asboolean then
FFin := True
else
FFin := False;
if FieldByName('Yes').asboolean then
FYes := True
else
FYes := False;
if FieldByName('Chk').asboolean then
FChk := True
else
FChk := False;
end
else
begin
FIns := False;
FDel := False;
FFin := False;
FChk := False;
FPrt := False;
FMod := False;
FYes := False;
end;
end;
end;
procedure TAudit.WriteLog(Act: integer; Content: string);
var
sql : string;
begin
with FClientDataSet do
begin
if ((Act = 1) and FIns) or ((Act = 2) and FDel) or ((Act = 3) and FFin) or((Act = 4) and FMod) or ((Act = 5) and FPrt) then
begin
close;
sql := 'INSERT INTO AuditLog (ProgramCode, ActionType, ActionCon, ActionTime, UserCode) VALUES ('''+FProgramCode
+''','+inttostr(Act)+','''+Content+''', GETDATE() ,'''+FuserCode+''' )';
CommandText := sql;
Execute;
end
else
if ((Act = 6) and FYes) or ((Act = 7) and FChk) then
begin
close;
CommandText := 'INSERT INTO AuditLog (ProgramCode, ActionType, ActionCon, ActionTime, UserCode) VALUES ('''+FProgramCode
+''','+inttostr(Act)+','''+Content+''', GETDATE() ,'''+FuserCode+''' )';
Execute;
end;
end;
end;
procedure Excel(clientdataset:tclientdataset;tiltename:string);
var
MSExcel,sheet:Variant;
i,j,T,H:Integer;
vstr:string;
begin
vstr:='';
if clientdataset.active then
begin
with clientdataset do
begin
DisableControls;
j:=RecordCount;
H:=FieldCount;
First;
for i:=0 to H-1 DO
vstr:=vstr+vartostr(FieldDefs.Items[i].DisplayName)+char(9);
vstr:=vstr+char(13);
for i:=1 to j do
begin
for t:=0 to H-1 do
begin
vstr:=vstr+vartostr(Fields[t].value)+char(9);
end;
vstr:=vstr+char(13);
clientdataset.Next;
end;
EnableControls;
clipboard.Clear;
clipboard.Open;
clipboard.astext:=vstr;
clipboard.Close;
MSExcel:=CreateoleObject('Excel.Application');
MSExcel.Workbooks.Add(-4167);
MSEXcel.workbooks[1].worksheets[1].name:=tiltename;
sheet:=MSEXcel.workbooks[1].worksheets[1];
sheet.paste;
MSExcel.Visible:=true;
end;
end;
end;
procedure TUser.GetAllSalRep(LST: TStrings);
var
strSQL: String;
begin
strSQL:='select rtrim(SalesRepID)+''@''+ltrim(ChineseName) SalesRep from SAL01050 ';
OpenQu(strSQL);
LST.Clear;
if UserClientDataset.IsEmpty then exit;
LST.Add('');
UserClientDataset.First;
while not UserClientDataset.Eof do
begin
LST.Add(UserClientDataset.FieldByName('SalesRep').Asstring);
UserClientDataset.Next;
end;
end;
procedure TUser.ExecQu(strSQL: String);
begin
UserClientDataset.Close;
UserClientDataset.CommandText:=strSQL;
UserClientDataset.Execute;
end;
procedure TUser.OpenQu(strSQL: String);
begin
UserClientDataset.Close;
UserClientDataset.CommandText:=strSQL;
UserClientDataset.Open;
end;
procedure TUser.GetOrderBillStatus(LST: TStrings);
var
strSQL: String;
begin
strSQL:='select rtrim(CodeID)+''-''+ltrim(CodeDesc) BillStatus from SYS02011(nolock) where CodeKind =''BillStatusID'' '
+'and charindex(Ltrim(rtrim(CodeID)),''ACDEZ'')>0 ';
OpenQu(strSQL);
LST.Clear;
if UserClientDataset.IsEmpty then exit;
LST.Add('');
UserClientDataset.First;
while not UserClientDataset.Eof do
begin
LST.Add(UserClientDataset.FieldByName('BillStatus').Asstring);
UserClientDataset.Next;
end;
end;
procedure TransferToExcel(DBGrid: TDBGrid; Save: TsaveDialog);
var
i: integer;
fieldStr: string;
i_file: TextFile;
begin
if Save.Execute then
begin
AssignFile(i_file, Save.FileName);
Rewrite(i_file);
with TDatasource(dbGrid.Datasource).Dataset do
begin
DisableControls;
for i := 0 to dbGrid.columns.count - 1 do
begin
if dbGrid.columns[i].Visible = true then
write(i_file, dbGrid.columns[i].title.caption + Char(9));
end;
writeln(i_file);
first;
while not Eof do
begin
for i := 0 to dbGrid.columns.count - 1 do
begin
if FieldByName(dbGrid.columns[i].fieldname).DataType = ftDateTime then
begin
fieldStr := '';
if not FieldByName(dbGrid.columns[i].fieldname).isnull then
fieldStr := fieldStr + dateTimetostr(FieldByName(dbGrid.columns[i].fieldname).asdatetime);
end
else if FieldByName(dbGrid.columns[i].fieldname).DataType = ftInteger then
begin
fieldStr := '';
if not FieldByName(dbGrid.columns[i].fieldname).isnull then
fieldStr := fieldStr + inttostr(FieldByName(dbGrid.columns[i].fieldname).asinteger);
end
else if FieldByName(dbGrid.columns[i].fieldname).DataType = ftsmallint then
begin
fieldStr := '';
if not FieldByName(dbGrid.columns[i].fieldname).isnull then
fieldStr := fieldStr + inttostr(FieldByName(dbGrid.columns[i].fieldname).asinteger);
end
else if FieldByName(dbGrid.columns[i].fieldname).DataType = ftString then
begin
fieldStr := '';
if not FieldByName(dbGrid.columns[i].fieldname).isnull then
begin
if LowerCase(dbGrid.columns[i].fieldname) = LowerCase('ConvertNumber') then
fieldStr := fieldStr + FieldByName(dbGrid.columns[i].fieldname).asstring
else
fieldStr := fieldStr + FieldByName(dbGrid.columns[i].fieldname).asstring;
end;
end
else if FieldByName(dbGrid.columns[i].fieldname).DataType = ftfloat then
begin
fieldStr := '';
if not FieldByName(dbGrid.columns[i].fieldname).isnull then
fieldStr := fieldStr + FieldByName(dbGrid.columns[i].fieldname).asstring;
end
else
begin
fieldStr := '';
if not FieldByName(dbGrid.columns[i].fieldname).isnull then
fieldStr := fieldStr + FieldByName(dbGrid.columns[i].fieldname).asstring;
end ;
if dbGrid.columns[i].Visible = true then
write(i_file, fieldStr + Char(9));
end;
writeln(i_file);
next;
end;
EnableControls;
Closefile(i_file);
Showmessage('存檔完成');
end;
end;
end;
Function GetObjectPath(PathClientDataSet : TClientDataSet;ObjectName,TableSeq: String):String;
var
SQL : string;
begin
SQL:='select rtrim(DBName)+''.''+rtrim(isnull(Owner,''DBO''))+''.''+ObjectName from ObjectPath where ObjectName='''+ObjectName+'''';
PathClientDataSet.Close;
PathClientDataSet.CommandText := SQL;
PathClientDataSet.Open;
if not PathClientDataSet.IsEmpty then
Result := PathClientDataSet.fields[0].AsString+' '+TableSeq
else
Result := ObjectName+' '+TableSeq;
end;
procedure AddPickList(ClientDataSet:TClientDataSet;DBGrid:TDBGrid;Seq:integer;Sql:string);
var
str:string;
begin
{ with ClientDataSet do
begin
close;
commandtext:=Sql;
open;
DBGrid.Columns[Seq].PickList.Clear;
first;
while not eof do
begin
str:=fields[0].AsString;
Column.PickList.Add(str);
next;
end;
end;
}end;
end.
- 公用類
- 公用函数库
- 公用账号
- 公用函数
- 什么是公用
- 公用函数
- 公用同义词
- 公用对话框
- 公用继承
- 公用配置文件
- 公用网络
- 公用combobox
- css公用
- 公用体
- 使公用系统更为公用
- 留言公用帐号
- 公用代码放置位置
- lotus 公用密钥
- 统计当前目录文件扩展名字的脚本
- 探索C++的秘密之详解extern
- 访问支付宝(淘宝)首页IE自动关闭解决方案
- 变量函数的使用技巧
- SC6600D_init.s
- 公用類
- 用Setup Factory 7.0制作安装程序 基础篇
- 导入EXCEL档到系统中
- 将OpenID以完整的URL的形式表达的例子
- Oracle to_date()与24小时制表示法及mm分钟的显示
- 使用ASP.NET 2.0提供的WebResource管理资源
- 如何手工编写动态链接库(windows dll)
- 修改活动进程链来隐藏进程代码
- HRESULT QueryInterface(IID &iid, void** ppvObj);