公用類

来源:互联网 发布: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.
原创粉丝点击