global.pas

程序採用了无状态连接池的三层结构

unit Global;

interface

uses Classes, Base, Windows, Sysutils, Winsock, Forms, Inifiles,
      Variants;

const
  gs_screenWidth: longint=800;
  gs_screenheight: longint=600;

type
  TfindArray1 = array[0..50] of string;
  TfindArray2 = array[0..50] of string;

type
  TbaseformClass = Class of TfrmBase;

var
  gs_userid,gs_groupid:integer;
  gs_usercode,gs_username,gs_password,gs_Servername:string;
  gs_admin:boolean;
  gs_workdate:Tdatetime;
  gs_apppath,gs_computername,gs_localip,gs_apptitle:string;
  gs_connect:integer;
  WorkDate:Tdatetime;

  {form variant define}
  Lockcount:integer;
  itemid:integer;

  findArray1:TfindArray1;
  findArray2:TfindArray2;
  Searchtiao:string;
  procedure initArray();
  procedure main_ini();
  Function f_PadL(sInput:string;iLen:integer;sFill:string):string;
  Function f_PadR(sInput:string;iLen:integer;sFill:string):string;
  Function f_encrypt(sInput:string):string;
  Function f_inencrypt(sInput:string):string;
  function space(len:integer):string;
  function f_getcomputername():string;
  function f_getlocalip():string;
  function f_getapppath():string;
  procedure f_writemainini(section,valueName,Valuestring:string);
  procedure openform(formclass:Tformclass;var fm;Aowner:Tcomponent);
  function vartosql(value: variant): string;
  function Roundfloat(f: double; i: integer): double;
  function syRmb(sourcemoney: real): widestring;

  function logins(usercode,password:string):integer;
  function getusername(const usercode, password: WideString): WideString;
  function getadmin(const usercode, password: WideString): WordBool;
  function getapptitle: WideString;
  function getgroupid(const usercode, username: WideString): Integer;
  function syslog(const fform, fevent: WideString): Integer;
  function execsql(const cmdstr: WideString): WordBool;
  function isunique(const ptablename, pkeyfield,pkeyvalue: WideString): WordBool;
  function getoutnumber(pbilltypeid: Integer): WideString; safecall;
  function getinnumber(pbilltypeid: Integer): integer; safecall;
  function pdetail(pitemid: Integer): OleVariant; safecall;

implementation

uses data;

procedure initArray();
begin
  Searchtiao:='';
  fillChar(findArray1,sizeof(findArray1),0);
  fillChar(findArray2,sizeof(findArray2),0);  
end;

procedure main_ini();
begin
  SysLocale.PriLangID:=LANG_CHINESE;
  DateSeparator:='.';
  LongDateFormat:='yyyy.mm.dd';
  ShortDateFormat:='yyyy.mm.dd';

  TimeSeparator:=':';
  LongTimeFormat:='hh:nn:ss';
  ShortTimeFormat:='hh:nn:ss';
  TimeAMString:='上午';
  TimePMString:='下午';
  LongDayNames[1]:='星期天';
  LongDayNames[2]:='星期一';
  LongDayNames[3]:='星期二';
  LongDayNames[4]:='星期三';
  LongDayNames[5]:='星期四';
  LongDayNames[6]:='星期五';
  LongDayNames[7]:='星期六';

  gs_AppPath:=f_GetAppPath();
  gs_computername:=f_GetComputerName;
  gs_localIP:=f_GetLocalIP;
end;

Function f_PadL(sInput:string;iLen:integer;sFill:string):string;
Var
   sAdd,sOutput:String;
   i,InputLen,FillLen,AddLen:integer;
begin
   FillLen:=length(sFill);
   InputLen:=length(sInput);
   AddLen:=iLen - InputLen;
   if AddLen <= 0 Then
      sOutput:=sInput
   else begin
      i:=InputLen+FillLen;
      while i <= iLen do
      begin
         sAdd:=sAdd + sFill;
         i:=i+FillLen;
      end;//for
      sAdd:=sAdd + copy(sFill,1,AddLen mod FillLen);
      sOutput := sAdd+sInput;
   end;//if
   Result:=sOutput;
end;

Function f_PadR(sInput:string;iLen:integer;sFill:string):string;
Var
   sAdd,sOutput:String;
   i,InputLen,FillLen,AddLen:integer;
begin
   FillLen:=length(sFill);
   InputLen:=length(sInput);
   AddLen:=iLen - InputLen;
   if AddLen <= 0 Then
      sOutput:=sInput
   else begin
      i:=InputLen+FillLen;
      while i <= iLen do
      begin
         sAdd:=sAdd + sFill;
         i:=i+FillLen;
      end;//for
      sAdd:=sAdd + copy(sFill,1,AddLen mod FillLen);
      sOutput:=sInput + sAdd;
   end;//if
   Result:=sOutput;
end;

Function f_encrypt(sInput:string):string;
Const
   AllChar:string='abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 ';
Var
   sOutput :string;
   iPin:byte;
begin
   if sInput = '' Then
      sOutput := ''
   else
   begin
//      sInput := f_PadR(sInput,20,' ');
      for iPin:=1 to Length(sInput) do
      begin
        sOutput := sOutput+Char(Ord(sInput[iPin]) + 128);
      end;
   end;
   Result := sOutput;
end;

Function f_inencrypt(sInput:string):string;
Const
   AllChar:string='abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 ';
Var
   sOutput :string;
   iPin:byte;
begin
   if sInput = '' Then
      sOutput := ''
   else
   begin
  //    sInput := f_PadR(sInput,20,' ');
      for iPin:=1 to Length(sInput) do
      begin
        sOutput := sOutput+Char(Ord(sInput[iPin]) + 128);
      end;
   end;
   Result := Trim(sOutput);
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 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 f_getlocalip():string;
type
  TaPInAddr = array [0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe  : PHostEnt;
  pptr : PaPInAddr;
  Buffer : array [0..63] of char;
  I    : Integer;
  GInitData      : TWSADATA;
begin
  WSAStartup($101, GInitData);
  Result := '';
  GetHostName(Buffer, SizeOf(Buffer));
  phe :=GetHostByName(buffer);
  if phe = nil then Exit;
  pptr := PaPInAddr(Phe^.h_addr_list);
  I := 0;
  while pptr^[I] <> nil do begin
    result:=StrPas(inet_ntoa(pptr^[I]^));
    Inc(I);
  end;
  WSACleanup;
end;

function f_getapppath():string;
Var
   ExePath:String;
   LastBackSlashPos,Index:Integer;
begin
   ExePath:=Application.ExeName;
   for Index := 1 to length(ExePath) do
      if ExePath[Index]='\' then
         LastBackSlashPos:=Index;
   Result:= Copy(ExePath,1,LastBackSlashPos-1);
end;

procedure f_writemainini(section,valueName,Valuestring:string);
var
  myinifile:Tinifile;
  myinifileName:string;
begin
  myinifilename:=Extractfilepath(application.ExeName)+'Default.ini';
  Myinifile:=Tinifile.Create(myinifilename);
  Myinifile.WriteString(section,valueName,ValueString);
  Myinifile.Free; 
end;

procedure openform(formclass:Tformclass;var fm;Aowner:Tcomponent);
var
  i: integer;
  Child:TForm;
begin
  Child:=nil;
  for i := 0 to Screen.FormCount -1 do
     if Screen.Forms[i].Classtype=FormClass then
      begin
        Child:=Screen.Forms[i];
        if Child.WindowState=wsMinimized then
           ShowWindow(Child.handle,SW_SHOWNORMAL)
        else
           ShowWindow(Child.handle,SW_SHOWNA);
      if (not Child.Visible) then Child.Visible:=True;
         Child.BringToFront;
         Child.Setfocus;
         TForm(fm):=Child;
         Child:=TForm(FormClass.NewInstance);
         exit;
      end;
  if Child=nil then
  begin
    with datam.CDSpermiss do
      begin
        if Locate('fuserid;fformcode',VarArrayof([gs_userid,
              lowercase(Trim(copy(Formclass.ClassName,2,Length(Formclass.ClassName)-1)))]),[]) then
          begin
            if fieldbyname('fopen').AsBoolean then
              begin
                TForm(fm):=Child;
                Child:=FormClass.Create(Application);
              end
              else
              begin
                application.MessageBox('您没有权限开启此模块 ! ','权限不够',
                                  MB_OK+MB_iconstop+MB_applmodal);
                Exit;
              end;
          end
          else
          begin
            application.MessageBox('您没有权限开启此模块 ! ','权限不够',
                              MB_OK+MB_iconstop+MB_applmodal);
            Exit;
          end;
      end;

  end;
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 Roundfloat(f: double; i: integer): double;
var
s:string;
ef:extended;
svalue:string;
begin
s:='#.'+stringofchar('0',i);
ef:=strtofloat(floattostr(f));
svalue:=formatfloat(s,ef);
if svalue<>'' then
        result:=strtofloat(sValue)
        else
        result:=0;
end;

function syRmb(sourcemoney: real): widestring;
var
  strsourcemoney,strobjectmoney:string;
  thiswei,thispos:string[2];
  iwei,pospoint:integer;
begin
  strsourcemoney:=formatfloat('0.00',sourcemoney);
  pospoint:=pos('.',strsourcemoney);

  for iwei:=length(strsourcemoney) downto 1 do
    begin
      case strsourcemoney[iwei] of
        '.':continue;
        '-':begin
          thiswei:='负';
          strobjectmoney:=thiswei+strobjectmoney;
          continue;
          end;
          '1':thiswei:='壹';'2':thiswei:='贰';
          '3':thiswei:='参';'4':thiswei:='肆';
          '5':thiswei:='伍';'6':thiswei:='陆';
          '7':thiswei:='柒';'8':thiswei:='捌';
          '9':thiswei:='玖';'0':thiswei:='零';
          end;
          case pospoint-iwei of
            -3:thispos:='厘';-2:thispos:='分';
            -1:thispos:='角';1:thispos:='元';
            2:thispos:='拾';3:thispos:='佰';
            4:thispos:='千';5:thispos:='万';
            6:thispos:='拾';7:thispos:='佰';
            8:thispos:='仟';9:thispos:='亿';
            10:thispos:='拾';11:thispos:='佰';
            12:thispos:='仟';
          end;
         strobjectmoney:=thiswei+thispos+strobjectmoney;
    end;
    Result:=strobjectmoney;
end;

function logins(usercode,password:string):integer;
begin
  Result:=datam.SCTlx.AppServer.login(usercode,password);
end;
function getusername(const usercode, password: WideString): WideString;
begin
  Result:=datam.SCTlx.AppServer.Getusername(usercode,password);
end;
function getadmin(const usercode, password: WideString): WordBool;
begin
  Result:=datam.SCTlx.AppServer.getadmin(usercode,password);
end;
function getapptitle: WideString;
begin
  Result:=datam.SCTlx.AppServer.getapptitle;
end;
function getgroupid(const usercode, username: WideString): Integer;
begin
  Result:=datam.SCTlx.AppServer.getgroupid(usercode,username);
end;
function syslog(const fform, fevent: WideString): Integer;
begin
  Result:=datam.SCTlx.AppServer.syslog(fform,fevent,gs_username,gs_computername);
end;
function execsql(const cmdstr: WideString): WordBool;
begin
  Result:=datam.SCTlx.AppServer.execsql(cmdstr);
end;
function isunique(const ptablename, pkeyfield,pkeyvalue: WideString): WordBool;
begin
  Result:=datam.SCTlx.AppServer.isunique(ptablename, pkeyfield,pkeyvalue);
end;
function getoutnumber(pbilltypeid: Integer): WideString;
begin
  Result:=datam.SCTlx.AppServer.getnumber(pbilltypeid);
end;
function getinnumber(pbilltypeid: Integer): integer;
begin
  Result:=datam.SCTlx.AppServer.getinnunber(pbilltypeid);
end;
function pdetail(pitemid: Integer): OleVariant;
begin
  Result:=datam.SCTlx.Appserver.purchasedetail(pitemid);
end;

end.