global.pas

用delphi编写的数据库管理软件

unit Global;

interface

uses
  Windows, Messages, SysUtils, Sconnect, Forms, Variants, DBClient, Controls,
  inifiles,Types, Classes, Strutils;

const
  m_showform = 'ShowForm';
  m_LockColumn = 'LockColumn';
  m_unLockColumn = 'unLockColumn';
  m_Close = 'Close';
  c_Succeed = 'Succeed';
  c_Failed = 'Failed';

var
  SaveApplication:TApplication;
  DllName:String;
  DLLSCT : TSocketConnection;
  DLLUcode:String;
  DLLCDS:TClientDataset;
  iModuleID:integer;
  sFunctionName:String;
  LockCount:integer;
  G_bAdmin:boolean;
  FromInterface:String;
  Searchtiao:String;
  FormHandle:hwnd;
  CurrentDBName:String;
  FormPrintName:string;
  SelectUnits:String;
  SelectUnitPrices:Double;
  SearchReturnID:integer;
  UserSelectBillNo:String;
  ItemImages:String;
  ItemID:integer;

  PublicData:OleVariant;


  function getnewname:String;
  function vartosql(value: variant): string;
  function cexecsql(const cmdStr: WideString): WordBool;
  function getscreenpoint(sender:Tcontrol):Tpoint;
  function csyslog(const fform, fevent: WideString): WordBool;
  function f_GetComputerName():String ;
  function CISunique(const TableName,MasterField,CheckValue:WideString):WordBool;
  function gs_GetAppPath:String;
  procedure SendDataToMain(handle:THandle;formname:String;IsDestry:integer=0);
  function SRNow():String;
  function space(len:integer):string;
  function MainApplicationHandle(MainFormName:String): HWND;
  function GetLogDir(RootDir:String):String;
  function getinnumber(pbilltypeid: Integer): integer;
  function getOutnumber(pbilltypeid: Integer): String;
  function syRmb(small: real): widestring;
  procedure OpenModalForm(FormClass: TFormClass; ParentFrom: TForm; var Form: TForm);
  function WriteDraft(pStatus:Integer;pBillName,pBillNo,pBillSelfNo,pCompany,pRemark,pCreaUser:WideString):WordBool;
  function GetBillStatus(const pSqlTiao: WideString): OleVariant;
  function IsVip(Const Cid:integer):WordBool;
  function GetVipID(Const CustomerID:integer):integer;
  function ExistVip(Const VipID:integer):WordBool;
  function WriteBalance(const pStatus, pBillStatus: Integer;
    const pNo, pBillName: WideString; pCusTomerID: Integer;
    const pRemark: WideString; pOverk, Poverf, Povert,
    pHire, pMortgage, pPMortgage, pPMainTain, pPBenZine, pPOther: Single): WordBool;
  procedure writeSqlText(section,valueName,Valuestring:string);
  function GetVehicleStatus: OleVariant;
  function f_Replace(Input,s1,s2:string): string;
  function GetFinanceBalance(Sdate,Edate: WideString): OleVariant;
  function GetFinanceCollect(Sdate,Edate: WideString): OleVariant;
  function VehicleRent(Vcode,Sdate,Edate: WideString): OleVariant;
  function CustomerRent(CustomerNo, Sdate, Edate: WideString): OleVariant;


implementation

function getnewname:String;
var
  Newname:String;
  n:integer;
begin
  n:=1111+Random(9999-1111);
  Newname:=inttostr(n);
  Result:=Newname;
end;

function vartosql(value: variant): string;
begin
  if varisnull(value) then
    Result:='NULL'
    else
    case vartype(value) of
      vardate:
        Result:=Quotedstr(Datetimetostr(vartodatetime(value)));
      varString,varOlestr:
        Result:=Quotedstr(Trim(Vartostr(value)));
      varboolean:
        begin
          if value then
            result:='1'
            else
            result:='0';
        end;
      else
        Result:=quotedstr(Trim(Vartostr(value)));
     end;
end;

function f_GetComputerName():String ;
var
  CNameBuffer : PChar;
  fl_loaded : Boolean;
  CLen : ^DWord;
begin
   GetMem(CNameBuffer,255);
    New(CLen);
    CLen^:= 255;
    fl_loaded := GetComputerName(CNameBuffer,CLen^);
    if fl_loaded then
      Result := StrPas(CNameBuffer)
    else
      Result := 'Unkown';
    FreeMem(CNameBuffer,255);
    Dispose(CLen);
end;

function getscreenpoint(sender:Tcontrol):Tpoint;
var
  clientpoint:Tpoint;
begin
  clientpoint:=point(0,sender.Height);
  while sender.Parent<>nil do
    begin
      clientpoint:=point(sender.Left+clientpoint.X,sender.Top+clientpoint.Y);
      sender:=Sender.Parent;
    end;
  clientpoint:=sender.ClientToScreen(clientpoint);
  Result:=clientpoint;
end;

function cexecsql(const cmdStr: WideString): WordBool;
begin
  Result:=DLLSCT.AppServer.execsql(CurrentDBName,cmdstr);
end;

function csyslog(const fform, fevent: WideString): WordBool;
begin
  Result:=DLLSCT.AppServer.syslog(CurrentDBName,c_Succeed,fform,fevent,DLLUcode,f_GetComputerName());
end;

function CISunique(const TableName,MasterField,CheckValue:WideString):WordBool;
begin
  Result:=DLLSCT.AppServer.IsUnique(CurrentDBName,TableName,MasterField,CheckValue);
end;

function SRNow():String;
begin
  Result:=DllSCT.AppServer.GetServerTime;
end;

function gs_GetAppPath:String;
begin
  Result:=Extractfilepath(Application.ExeName);
end;

procedure SendDataToMain(handle:THandle;formname:String;IsDestry:integer=0);
Var
  ds:TCopyDataStruct;
  cFormName:String;
begin
  try
    cFormName :=formname;
    ds.cbData:=Length(cFormName)+1;
    ds.dwData := IsDestry;
    GetMem(ds.lpData,ds.cbData);
    strcopy(ds.lpData,Pchar(cFormName));
    SendMessage(FormHandle,WM_COPYDATA,handle,Cardinal(@ds));
  finally
    FreeMem(ds.lpData);
  end;
end;

function space(len:integer):string;
Var
  i:integer;
   sResult:string;
begin
for i := 1 to len do
   begin
   sResult := sResult + ' ';
   end;
   Result := sResult;
end;

function MainApplicationHandle(MainFormName:String): HWND;
var
  MainModule: HMODULE;
  CurrentPID: DWORD;
  WindowsPID: DWORD;
begin
  MainModule := GetModuleHandle(nil);
  CurrentPID := GetCurrentProcessID();

  Result := 0;
  while True do
  begin
    Result := FindWindowEx(0, Result, Pchar(MainFormName), nil);
    if (Result = 0) then Exit;

    GetWindowThreadProcessID(Result, WindowsPID);
    if (WindowsPID = CurrentPID) and
       (HMODULE(GetWindowLong(Result, GWL_HINSTANCE)) = MainModule)
    then Exit;
  end;
end;

function GetLogDir(RootDir:String):String;
var
  SAppPath:String;
begin

SAppPath:=ExtractfilePath(Application.ExeName);
  If Copy(SappPath,Length(SappPath),1)='\' then
    Delete(SappPath,length(SappPath),1);
  while (Copy(SappPath,Length(SappPath),1)<>'\') and (Length(SappPath)>0) do
    Delete(SappPath,length(SappPath),1);
  if SappPath<>'' then
    begin
      if not DirectoryExists(SappPath+RootDir+'\') then
        CreateDir(SappPath+RootDir+'\');
      Result:=SappPath+RootDir+'\';
    end
    else
    Result:='c:\';
end;

procedure OpenModalForm(FormClass: TFormClass; ParentFrom: TForm; var Form: TForm);
begin
  if not Assigned(Form) then
    Form := FormClass.Create(ParentFrom);
  Form.ShowModal;
  Form:=nil;
  Form.free;
end;

function getinnumber(pbilltypeid: Integer): integer;
begin
  Result:=DLLSCT.AppServer.getinnumber(CurrentDBName,pbilltypeid);
end;

function getOutnumber(pbilltypeid: Integer): String;
begin
  Result:=DLLSCT.AppServer.getOutNumber(CurrentDBName,pbilltypeid);
end;

function syRmb(small: real): widestring;
var SmallMonth,BigMonth:string;
wei1,qianwei1:string[2];
qianwei,dianweizhi,qian:integer;
begin
{------- 修改参数令值更精确 -------}
{小数点后的位置，需要的话也可以改动-2值}
qianwei:=-2;
{转换成货币形式，需要的话小数点后加多几个零}
Smallmonth:=formatfloat('0.00',small);
{---------------------------------}
dianweizhi :=pos('.',Smallmonth);{小数点的位置}
{循环小写货币的每一位，从小写的右边位置到左边}
for qian:=length(Smallmonth) downto 1 do
  begin
    {如果读到的不是小数点就继续}
    if qian<>dianweizhi then
      begin
      {位置上的数转换成大写}
        case strtoint(copy(Smallmonth,qian,1)) of
          1:wei1:='壹'; 2:wei1:='贰';
          3:wei1:='叁'; 4:wei1:='肆';
          5:wei1:='伍'; 6:wei1:='陆';
          7:wei1:='柒'; 8:wei1:='捌';
          9:wei1:='玖'; 0:wei1:='零';
        end;
        {判断大写位置，可以继续增大到real类型的最大值}
        case qianwei of
        -3:qianwei1:='厘';
        -2:qianwei1:='分';
        -1:qianwei1:='角';
        0 :qianwei1:='元';
        1 :qianwei1:='拾';
        2 :qianwei1:='佰';
        3 :qianwei1:='千';
        4 :qianwei1:='万';
        5 :qianwei1:='拾';
        6 :qianwei1:='佰';
        7 :qianwei1:='千';
        8 :qianwei1:='亿';
        9 :qianwei1:='十';
        10:qianwei1:='佰';
        11:qianwei1:='千';
        end;
      inc(qianwei);
      BigMonth :=wei1+qianwei1+BigMonth;{组合成大写金额}
      end;
  end;
  Result:=BigMonth;
end;

function GetBillStatus(const pSqlTiao: WideString): OleVariant;
begin
  Result:=DLLSCT.AppServer.GetBillStatus(CurrentDBName,pSqlTiao);
end;

function WriteDraft(pStatus:Integer;pBillName,pBillNo,pBillSelfNo,pCompany,pRemark,pCreaUser:WideString):WordBool;
begin
Result:=DLLSCT.AppServer.WriteDraft(CurrentDBName,pStatus,pBillName, pBillNo, pBillSelfNo,pCompany, pRemark, pCreaUser);
end;

function IsVip(Const Cid:integer):WordBool;
begin
  Result:=DLLSCT.AppServer.ISVIP(CurrentDBName,CID);
end;

function GetVipID(Const CustomerID:integer):integer;
begin
  Result:=DLLSCT.AppServer.GetVIPID(CurrentDBName,CustomerID);
end;

function ExistVip(Const VipID:integer):WordBool;
begin
  Result:=DllSct.AppServer.ExistVip(CurrentDBName,VipID);
end;

function WriteBalance(const pStatus, pBillStatus: Integer;
    const pNo, pBillName: WideString; pCusTomerID: Integer;
    const pRemark: WideString; pOverk, Poverf, Povert,
    pHire, pMortgage, pPMortgage, pPMainTain, pPBenZine, pPOther: Single): WordBool;
begin
  Result:=DLLSct.AppServer.WriteBalance(CurrentDBName,pStatus, pBillStatus, pNo, pBillName,
           pCusTomerID, pRemark,pOverk, Poverf, Povert, pHire, pMortgage,
           pPMortgage, pPMainTain, pPBenZine, pPOther, DLLUcode);
end;

procedure writeSqlText(section,valueName,Valuestring:string);
var
  myinifile:Tinifile;
  myinifileName:string;
begin
  myinifilename:=GetLogDir('Log')+'sqltext.ini';
  Myinifile:=Tinifile.Create(myinifilename);
  Myinifile.WriteString(section,valueName,ValueString);
  Myinifile.Free;
end;

function GetVehicleStatus: OleVariant;
begin
  Result:=DLLSCT.AppServer.GetVehicleStatus(CurrentDBName);
end;

function f_Replace(Input,s1,s2:string): string;
begin
   Result:='';
   while Pos(s1,Input) > 0 do
   begin
      Result:= Result+LeftStr(Input,pos(s1,Input)-1)+s2;
      Input:=RightStr(Input,length(Input)-Pos(s1,Input)-length(s1)+1);
   end;
   Result:=Result+Input;
end;

function GetFinanceBalance(Sdate,Edate: WideString): OleVariant;
begin
  Result:=DLLSCT.AppServer.GetFinanceBalance(CurrentDBName,Sdate,Edate);
end;                                                              

function GetFinanceCollect(Sdate,Edate: WideString): OleVariant;
begin
  Result:=DLLSCT.AppServer.GetFinanceCollect(CurrentDBName,Sdate,Edate);
end;

function VehicleRent(Vcode,Sdate,Edate: WideString): OleVariant;
begin
  Result:=DLLSCT.AppServer.VehicleRent(CurrentDBName,Vcode,Sdate,Edate);
end;

function CustomerRent(CustomerNo, Sdate, Edate: WideString): OleVariant;
begin
  Result:=DLLSCT.AppServer.CustomerRent(CurrentDBName,CustomerNO,Sdate,Edate);
end;

end.