unit spmain; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Menus, ComCtrls, ToolWin, ActnMan, ActnCtrls, ActnMenus, ActnList, DB, ADODB, Grids,IniFiles, jpeg, ExtCtrls, Buttons, ImgList, StdCtrls, cxControls, cxSplitter, MovePanel; const keys='ljb^0122!@#*&^%$'; type TFormMain = class(TForm) StatusBar1: TStatusBar; ADOConnection1: TADOConnection; ImageList25: TImageList; ImageList3: TImageList; ImageList24: TImageList; ADQ_Temp: TADOQuery; Image_Tree: TImageList; ADOQueryTmp: TADOQuery; Timer2: TTimer; MovePanel1: TMovePanel; Panel1: TPanel; Panel2: TPanel; Panel3: TPanel; procedure FormCreate(Sender: TObject); procedure MNCloseClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Timer1Timer(Sender: TObject); procedure FormResize(Sender: TObject); procedure N2Click(Sender: TObject); procedure Timer2Timer(Sender: TObject); procedure FormShow(Sender: TObject); procedure ToolButton12Click(Sender: TObject); procedure Panel1Click(Sender: TObject); procedure Panel2Click(Sender: TObject); procedure Panel3Click(Sender: TObject); private { Private declarations } function intiData():Boolean; procedure GetServerDate(); public { Public declarations } // server, dtbase, user, pswd: String; end; var FormMain: TFormMain; gServerDate:TdateTime; server, dtbase, user, pswd: String; {数据库连接参数} gConString:String; {全局连接字符串} gCurHandle:hwnd; //当前窗体句柄 V_User,V_UserID,User_Id,User_Name:String; newh:hwnd; ConDateBaseString:String; implementation uses logon, U_Link,U_iniParam; {$R *.dfm} function TFormMain.intiData():Boolean; var mProdId:string; //当前产品号 begin result:=false; //ConDateBaseString:=ADOConnection1.ConnectionString; try frmLink:=TfrmLink.create(self); if frmLink.ShowModal=1 then begin ConDateBaseString:=frmLink.fADOConnString; frmLink.hide; end else begin application.MessageBox('通讯服务器连接错误!','提示信息',MB_ICONERROR); PostMessage(Handle, WM_CLOSE, 0, 0); frmLink.Release; end; except application.MessageBox('通讯服务器连接错误!','提示信息',MB_ICONERROR); PostMessage(Handle, WM_CLOSE, 0, 0); end; // ConDateBaseString:=ADOConnection1.ConnectionString; { Left := 0; Top := 0; Width := Screen.Width; Height := Screen.Height; } try with ADOConnection1 do begin ADOConnection1.KeepConnection:=false; ADOConnection1.KeepConnection:=true; Connected:=false; ConnectionString:= ConDateBaseString; Connected:=true; end; Result:=true; except result:=false; application.MessageBox('数据库连接错误!','提示信息',MB_ICONERROR); PostMessage(Handle, WM_CLOSE, 0, 0); end; end; procedure TFormMain.FormCreate(Sender: TObject); var tmpstr: String; begin if intiData() then begin GetServerDate(); // P_Tmp.Visible := True; //P_Tmp.Align := AlClient; FormLogon:=TFormLogon.Create(self); FormLogon.ShowModal; end; end; procedure TFormMain.FormResize(Sender: TObject); begin //P_Tmp.Align := AlClient; sendmessage(newh,1034,1,0); end; procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction); Var CanQuit:Boolean; begin sendmessage(newh,1034,4,0); If FormMain.MDICHildCount > 0 Then CanQuit:=application.MessageBox('您确定需要退出当前系统吗?','提示',mb_yesno+ mb_IconQuestion)=idyes ; If CanQuit Then begin Timer2.Enabled := false; ADOConnection1.Close; Action := CaFree; End Else action := caNone; end; procedure TFormMain.MNCloseClick(Sender: TObject); begin close; end; procedure TFormMain.Timer1Timer(Sender: TObject); begin try statusbar1.Panels[0].Text:='当前时间:'+datetimetostr(now); except end; end; procedure TFormMain.N2Click(Sender: TObject); begin end; /////////////////////////////////////////////// //函数:获取系统参数 //////////////////////////////////////////////// procedure TFormMain.GetServerDate(); begin with ADOQueryTmp do begin close; sql.clear; sql.Add('select getDate()as dt'); Open; gServerDate:=fieldByName('dt').AsDateTime; close; end; end; procedure TFormMain.Timer2Timer(Sender: TObject); begin FormMain.StatusBar1.Panels[0].Text:='当前时间:'+datetimetostr(now); end; procedure TFormMain.FormShow(Sender: TObject); begin Timer2.Enabled:=True; end; procedure TFormMain.ToolButton12Click(Sender: TObject); var CanQuit:Boolean; begin sendmessage(newh,1034,4,0); if application.MessageBox('您确定需要退出当前系统吗?','提示',mb_yesno+ mb_IconQuestion)<>IDYES then Exit; ADOConnection1.Close; Close; end; procedure TFormMain.Panel1Click(Sender: TObject); type TMyFunc = function(App:Tapplication; FormH:hwnd; FormID:integer; Language: integer; WinStyle:integer; GCode: Pchar; GName: Pchar; DataBase:Pchar;Title:PChar; Parameters1:PChar;Parameters2:PChar;Parameters3:PChar;Parameters4:PChar; Parameters5:PChar;Parameters6:PChar;Parameters7:PChar;Parameters8:PChar; Parameters9:PChar;Parameters10:PChar;DataBaseStr:PChar):hwnd;stdcall; var Tf: TMyFunc; Tp: TFarProc; Th:Thandle; begin //静态加载 //newh:=getForm(Application,1,ADOConnection1,PChar('sa'),PChar('dsa')); //动态加载 // showMessage(intTostr(application.Handle)); ADOConnection1.Connected:=False; ADOConnection1.Connected:=True; { with ADOQueryTmp do begin Close; sql.Clear; sql.Add('select * from SY_User where UserId='''+Trim(User_Id)+''''); Open; end; if Trim(ADOQueryTmp.FieldByName('BanZu').AsString)='' then begin Application.MessageBox('当前登录人班组为空!','提示',0); Exit; end; } with ADOQueryTmp do begin Close; sql.Clear; sql.Add('select * from SY_ModuleSub where ModuleSubID=''99'' '); Open; end; if ADOQueryTmp.IsEmpty then begin Application.MessageBox('没有设置检验信息模块!','提示信息',MB_ICONERROR); Exit; end; Th := LoadLibrary(Pchar(trim(ADOQueryTmp.fieldbyname('formFile').AsString))); if Th > 0 then begin try Tp := GetProcAddress(Th, 'GetDllForm'); if Tp <> nil then begin Tf := TMyFunc(Tp); newh:=Tf(Application,0,ADOQueryTmp.fieldbyname('formID').AsInteger,0,0, PChar(User_Id), PChar(User_Name), PChar(trim(ADOQueryTmp.fieldbyname('formpara').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formname').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara1').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara2').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara3').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara4').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara5').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara6').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara7').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara8').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara9').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara10').AsString)), PChar(ConDateBaseString) ); end else begin ShowMessage('打印执行错误'); end; finally // FreeLibrary(); end; end else begin ShowMessage('找不到'+Trim('dllname')); end; end; procedure TFormMain.Panel2Click(Sender: TObject); var CanQuit:Boolean; begin sendmessage(newh,1034,4,0); if application.MessageBox('您确定需要退出当前系统吗?','提示',mb_yesno+ mb_IconQuestion)<>IDYES then Exit; ADOConnection1.Close; Close; end; procedure TFormMain.Panel3Click(Sender: TObject); type TMyFunc = function(App:Tapplication; FormH:hwnd; FormID:integer; Language: integer; WinStyle:integer; GCode: Pchar; GName: Pchar; DataBase:Pchar;Title:PChar; Parameters1:PChar;Parameters2:PChar;Parameters3:PChar;Parameters4:PChar; Parameters5:PChar;Parameters6:PChar;Parameters7:PChar;Parameters8:PChar; Parameters9:PChar;Parameters10:PChar;DataBaseStr:PChar):hwnd;stdcall; var Tf: TMyFunc; Tp: TFarProc; Th:Thandle; begin //动态加载 // showMessage(intTostr(application.Handle)); ADOConnection1.Connected:=False; ADOConnection1.Connected:=True; { with ADOQueryTmp do begin Close; sql.Clear; sql.Add('select * from SY_User where UserId='''+Trim(User_Id)+''''); Open; end; if Trim(ADOQueryTmp.FieldByName('BanZu').AsString)='' then begin Application.MessageBox('当前登录人班组为空!','提示',0); Exit; end; } with ADOQueryTmp do begin Close; sql.Clear; sql.Add('select * from SY_ModuleSub where ModuleSubID=''97'' '); Open; end; if ADOQueryTmp.IsEmpty then begin Application.MessageBox('没有设置拆分合并模块!','提示信息',MB_ICONERROR); Exit; end; Th := LoadLibrary(Pchar(trim(ADOQueryTmp.fieldbyname('formFile').AsString))); if Th > 0 then begin try Tp := GetProcAddress(Th, 'GetDllForm'); if Tp <> nil then begin Tf := TMyFunc(Tp); newh:=Tf(Application,0,ADOQueryTmp.fieldbyname('formID').AsInteger,0,0, PChar(User_Id), PChar(User_Name), PChar(trim(ADOQueryTmp.fieldbyname('formpara').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formname').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara1').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara2').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara3').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara4').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara5').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara6').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara7').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara8').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara9').AsString)), PChar(trim(ADOQueryTmp.fieldbyname('formpara10').AsString)), PChar(ConDateBaseString) ); end else begin ShowMessage('打印执行错误'); end; finally // FreeLibrary(); end; end else begin ShowMessage('找不到'+Trim('dllname')); end; end; end.