systemfuncunit.pas

实达企业在线EOL源码

//****************************************************************************//
//                                                                            //
//  产品 : EOL AppServer                                                      //
//  单元 : SystemFunc.Pas                                                     //
//  版本 : 1.0                                                                //
//  作者 : 孙卫东                                                             //
//  描述 : 提供系统功能                                                       //
//  日期 : 2000-08-24                                                         //
//                                                                            //
//  COPYRIGHT (C) 2000 START-TECH.                                            //
//                                                                            //
//                                                                            //
//  说明 ：                                                                   //
//  修订 ：                                                                   //
//****************************************************************************//

unit SystemFuncUnit;

interface

uses Forms,Windows,Controls,sconnect,SysUtils,comctrls,ProgressUnit,Winsock;

var
  ProgressThread : TWorkProgress;

  {函数定义}
  function ShowFormOn(AForm: TForm; AControl: TWinControl): Boolean;
  function ShowFormIn(AForm: TForm;AControl: TWinControl): boolean; {嵌入显示窗体}
  function GetInfo(InfoName:string):string; {获取系统信息}

  function GetBillStatus(StatusNo: string):string; {获取单据状态}
  function GetBillCloseFlag(CloseFlag: string): string;  {获取单据关闭状态}

  function GetSocketConnection: TSocketConnection;

  function PFormatDate(const str: ShortString) : ShortString ;
  function PDeFormatDate(const str: ShortString) : ShortString ;
  function PValidDate(var strDate: String): Boolean;

  function GetLocalComputerName:String;
  function GetLocalAddress: string;

  procedure StartProgress(Bar: TProgressBar = nil; Max: integer = 10000);
  procedure StopProgress;

implementation

uses DlgLoginForm, BasDataForm, SystemConstUnit, MainForm;

function ShowFormOn(AForm: TForm; AControl: TWinControl): Boolean;
var
  P : TPoint;
begin
  Result := False;
  if Assigned(AControl) and Assigned(AForm) then
  begin
    try
      P.X := AControl.Left;
      P.Y := AControl.Top;
      P := AControl.ClientToScreen(P);
      AForm.Left := P.X - 2;
      AForm.Top := P.Y;
      AForm.Width := AControl.ClientWidth;
      AForm.Height := AControl.ClientHeight;
      AForm.ShowModal;
      Result := True;
    except
    end;
  end;
end;

function ShowFormIn(AForm: TForm;AControl: TWinControl): boolean;
begin
  if Assigned(AControl) and Assigned(AForm) then
  begin
    AForm.Left := 0;
    AForm.Top := 0;
    AForm.Width := AControl.ClientWidth ;
    AForm.Height := AControl.ClientHeight ;
    AForm.Parent := AControl;
    AForm.WindowState := wsMaximized;

    AForm.Show;
  end;
  Result := False;
end;

function GetBillStatus(StatusNo: string):string;
begin
  Result := '未知';

  if StatusNo = '0' then
     Result := '作废';
  if StatusNo = '1' then
     Result := '未确认';
  if StatusNo = '2' then
     Result := '确认';
  if StatusNo = '3' then
     Result := '已审核';
  if StatusNo = '4' then
     Result := '已记账';
end;

function GetBillCloseFlag(CloseFlag: string): string;
begin
  Result := '未知';
  if CloseFlag = '0' then
    Result := '关闭';
  if CloseFlag = '0' then
    Result := '正常';
end;

function GetInfo(InfoName:string):string;
begin

  if InfoName='AppName' then begin
     Result:=Application.Title;
  end
  else  if InfoName='LoginUserID' then begin
     Result:='';
  end
  else  if InfoName='LoginUserName' then begin
     Result:='';
  end
  else
  if InfoName='CopyRight' then begin
     Result:='版权所有 (C) 2000 实达科技(广州)软件公司';
  end
  else
  if InfoName='UserName' then begin
     Result:='孙卫东';
  end
  else
  if InfoName='CorpName' then begin
     Result:='恒安（国际）集团公司';
  end
  else
  if InfoName='ProductName' then begin
     Result:='东方之星ERP';
  end
  else
  if InfoName='MemInfo' then
     Result:='Window 物理内存为 64 MB'
  else
  if InfoName='MachineName' then
     Result:= '';

end;

function GetSocketConnection: TSocketConnection;
begin
  Result:=nil;
end;

function PFormatDate(const str : ShortString): ShortString;
var
  szYear,szMonth, szDay: ShortString;
begin
  szYear:=Copy(str,1,4);
  szMonth:= Copy(str, 5, 2);
  szDay  := Copy(str, 7, 2);
  Result := szYear + '-' + szMonth + '-' + szDay;
end;

function PDeFormatDate(const str: ShortString) : ShortString ;
begin
  Result:='';
  if Trim(str)='' then exit;
  Result :=Copy(str,1,4)+Copy(str,6,2)+Copy(str,9,2);
end;

//判断用户输入的日期是否有效
function PValidDate(var strDate: String): Boolean;
var
  curSep:Char;
  validSep:array [1..3] of Char;
  sDate,sYear,sMonth,sDay : string;
  iLen,iPos,i:integer;
  iYear, iMonth, iDay, iLastDay: Integer;
const
  DaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
  Result:=False;
  strDate:=Trim(StrDate);
  if strDate='' then exit;
  if Pos(' ',strDate)>0 then exit;
  validSep[1]:='-';
  validSep[2]:='.';
  validSep[3]:='/';
  for i:=1 to 3 do
    if Pos(validSep[i],strDate)>0 then break;
  if i>3 then exit;
  curSep:=validSep[i];
  iLen:=Length(strDate);
  iPos:=Pos(curSep,strDate);
  sYear:=Copy(strDate,1,iPos-1);
  i:=Length(sYear);
  if (i<>2) and (i<>4) then exit;
  if i=2 then
    if StrToInt(sYear)>70 then
      sYear:='19'+sYear
    else
      sYear:='20'+sYear;
  sDate:=Copy(strDate,iPos+1,iLen-iPos);
  iLen:=Length(sDate);
  iPos:=Pos(curSep,sDate);
  if iPos=0 then exit;
  sMonth:=Copy(sDate,1,iPos-1);
  if (Length(sMonth)>2) or (Length(sMonth)<1) then exit;
  if Length(sMonth)=1 then sMonth:='0'+sMOnth;
  sDay:=Copy(sDate,iPos+1,iLen-iPos);
  if (Length(sDay)>2) or (Length(sDay)<1) then exit;
  if Length(sDay)=1 then sDay:='0'+sDay;
  strDate:=sYear+sMonth+sDay;
  iYear := StrToInt( Copy( strDate, 1,4) ) ;
  iMonth := StrToInt( Copy( strDate, 5, 2 ) );
  iDay := StrToInt( Copy(strDate, 7, 2) );
  if (iYear<0) or (iMonth<1) or (iDay<1) then
    exit
  else
  begin
    iLastDay := DaysInMonth[ iMonth ] ;
    if (iYear mod 4 = 0) and ((iYear mod 100 <> 0) or (iYear mod 400 = 0)) and (iMonth = 2) then
	Inc(iLastDay);
    if (iMonth>12) or (iDay>iLastDay) then exit;
  end;
  Result:=True;
  strDate:=PFormatDate(strDate);
end;

//Add by masj 2000/12/30
function GetLocalAddress: string;
var
wVersionRequested : WORD;
wsaData : TWSAData;
p : PHostEnt;
s : array[0..128] of char;
p2 : pchar;
begin
  {创建 WinSock}
  result:='';
  wVersionRequested := MAKEWORD(1, 1);
  WSAStartup(wVersionRequested, wsaData);

  {得到计算机名称}
  GetHostName(@s,128);
  p:=GetHostByName(@s);

  {得到机器IP地址}
  p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
  result:=p2;
  WSACleanup;
end;

procedure StartProgress(Bar: TProgressBar = nil; Max: integer = 10000);
begin
  //Exit;
  if ProgressThread = nil then
  begin
    if Bar = nil then
      ProgressThread := TWorkProgress.CreateIt(MainFrm.ProgressBar1,Max)
    else
      ProgressThread := TWorkProgress.CreateIt(Bar,Max);
  end;
end;

procedure StopProgress;
begin
  //Exit;
  if ProgressThread <> nil then
  begin
    ProgressThread.Terminate;
    ProgressThread.WaitFor;
    ProgressThread := nil;
  end;
end;

function GetLocalComputerName:String;
var
  aName : PChar;
  Len : Cardinal;
begin
  result := '';
  Len := MAX_COMPUTERNAME_LENGTH + 1;
  GetMem(aName,Len);
  try
    if GetComputerName(aName,Len) then
      result := StrPas(aName);
  finally
    FreeMem(aName);
  end;
end;


end.