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,SyncObjs, System.ImageList, cxGraphics, cxLookAndFeels, cxLookAndFeelPainters, cxButtons; type TMyThread = class(TThread) protected procedure Execute; override; end; 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; Timer_link: TTimer; Panel4: 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); procedure Timer_linkTimer(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Panel4Click(Sender: TObject); private { Private declarations } function intiData():Boolean; procedure GetServerDate(); procedure InitDllEvt(FromFile:String;FormID:Integer;Para:String;FormType:Integer; Title: String; Def1: String; Def2: String; Def3: String; Def4: String; Def5: String; Def6: String; Def7: String; Def8: String; Def9: String; Def10: string); public procedure threadLoadDll( mFileName:string); { 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; CriticalSection:TCriticalSection; {声明临界} implementation uses logon,U_Link, U_iniParam, U_staffSeList; {$R *.dfm} procedure TMyThread.Execute; begin FreeOnTerminate := True; CriticalSection.Enter; try with FormMain.ADOQueryTmp do begin close; sql.Clear; sql.Add('select getdate()'); open; end; except try with FormMain.ADOConnection1 do begin Connected:=false; ConnectionString:=ConDateBaseString; LoginPrompt:=false; Connected:=true; end; except end; end; CriticalSection.Leave; end; function TFormMain.intiData():Boolean; var mProdId:string; //当前产品号 begin SetLength(server, 255); SetLength(dtbase, 255); SetLength(user, 255); SetLength(pswd, 255); server:=''; dtbase:=''; user:='sa'; pswd:='rightsoft@123'; ADOConnection1.ConnectionString := 'Provider=SQLOLEDB.1;Password='+pswd+';Persist Security Info=True;User ID=' +user+';Initial Catalog='+dtbase+';Data Source='+server; // ConDateBaseString:=ADOConnection1.ConnectionString; try frmLink:=TfrmLink.create(self); if frmLink.ShowModal=1 then begin ADOConnection1.ConnectionString:=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 ADOConnection1.Close; ADOConnection1.Open; Result:=true; except result:=false; application.MessageBox('数据库连接失败!', '错误',mb_Ok+ MB_ICONERROR); PostMessage(self.handle, WM_CLOSE, 0, 0); end; end; procedure TFormMain.FormCreate(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; newh:hwnd; tmpstr: String; begin if IsINIFile() then ReadINIFile() else WriteINIFile ; //岗位配置 readTradeInspINIFile(); StatusBar1.Panels[3].Text:='机台人员:'+ gMachOperators ; // if intiData() then begin GetServerDate(); // P_Tmp.Visible := True; //P_Tmp.Align := AlClient; try FormLogon:=TFormLogon.Create(self); FormLogon.ShowModal; finally FormLogon.free; end; end; // Th := LoadLibrary('FileUpdate.dll'); // if Th > 0 then // begin // try // Tp := GetProcAddress(Th, 'GetDllForm'); // if Tp <> nil then // begin // Tf := TMyFunc(Tp); // newh:=Tf(Application,0,2,0,0, // PChar(User_Id), // PChar(User_Name),PChar(''),PChar(''),PChar(''),PChar(''),PChar(''),PChar(''),PChar(''),PChar(''),PChar(''),PChar(''),PChar(''),PChar(''),PChar(ConDateBaseString)); // end // else // begin // ShowMessage('打印执行错误'); // end; // finally // // FreeLibrary(Th); // end; // end // else // begin // ShowMessage('找不到FileUpdate.dll'); // end; WriteINIFile ; CriticalSection:=TCriticalSection.Create; end; procedure TFormMain.FormResize(Sender: TObject); begin sendmessage(newh,1034,1,0); // Panel1Click(Panel1); 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); var XSStr:string; begin try IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'FileKPZ.INI'); Panel1.Caption := IniFile.ReadString('生产车间配置', '模块名称1','手工检验'); Panel3.Caption := IniFile.ReadString('生产车间配置', '模块名称2','扫描检验'); XSStr:= IniFile.ReadString('生产车间配置', '模块显示1','1'); if XSStr='1' then begin Panel1.Visible:=True; end else begin Panel1.Visible:=False; end; XSStr:= IniFile.ReadString('生产车间配置', '模块显示2','0'); if XSStr='1' then begin Panel3.Visible:=True; end else begin Panel3.Visible:=False; end; finally IniFile.Free; end; WriteTradeInspINIFile(); // if gAutoWinForm='1' then // Panel1Click(Panel1); application.ProcessMessages; 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; DllName,DllInt:String; IniFile:TIniFile; begin ADOConnection1.Connected:=False; ADOConnection1.Connected:=True; try IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'FileKPZ.INI'); DllName := IniFile.ReadString('生产车间配置', 'DLL文件1','DjdMachineInsp.dll'); DllInt := IniFile.ReadString('生产车间配置', 'DLL调用号1','3'); finally IniFile.Free; end; Th := LoadLibrary(PChar(DllName)); if Th > 0 then begin try Tp := GetProcAddress(Th, 'GetDllForm'); if Tp <> nil then begin Tf := TMyFunc(Tp); newh:=Tf(Application,0,strToint(DllInt),0,0, PChar(User_Id), PChar(User_Name), PChar(''), PChar(Tpanel(Sender).Caption), PChar(''), PChar(''), '','','','','','','','',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; DllName,DllInt:String; IniFile:TIniFile; begin ADOConnection1.Connected:=False; ADOConnection1.Connected:=True; // try // IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'FileKPZ.INI'); // gDllName1 := IniFile.ReadString('生产车间配置', 'DLL文件2','DjdMachineInsp.dll'); // DllInt := IniFile.ReadString('生产车间配置', 'DLL调用号2','1'); // finally // IniFile.Free; // end; Th := LoadLibrary(PChar(gDllName1)); if Th > 0 then begin try Tp := GetProcAddress(Th, 'GetDllForm'); if Tp <> nil then begin Tf := TMyFunc(Tp); newh:=Tf(Application,0,1,0,0, PChar(User_Id), PChar(User_Name), PChar(''), PChar(TToolButton(Sender).Caption), PChar(''), PChar(''), '','','','','','','','',PChar(ConDateBaseString) ); end else begin ShowMessage('打印执行错误'); end; finally // FreeLibrary(); end; end else begin ShowMessage('找不到'+Trim('dllname')); end; end; procedure TFormMain.Panel4Click(Sender: TObject); begin frmStaffSelList:=TfrmStaffSelList.create(self); with frmStaffSelList do begin if showModal=1 then begin gMachOperators:= fSelUsersName ; WriteTradeInspINIFile(); StatusBar1.Panels[3].Text:='机台人员:'+ fSelUsersName ; end; free; end; end; procedure TFormMain.Timer_linkTimer(Sender: TObject); begin TMyThread.Create(False); end; procedure TFormMain.FormDestroy(Sender: TObject); begin CriticalSection.Free; end; //////////////////////////////////////////////// procedure TFormMain.threadLoadDll( mFileName:string); var thread:Tthread; begin if not fileexists(ExtractFilePath(Application.ExeName) + mFileName) then exit; thread:=TThread.CreateAnonymousThread( procedure begin TThread.Synchronize(nil, procedure begin InitDllEvt(mFileName,99999,'',0,'缓存窗口','','','','','','','','','',''); end) end); thread.FreeOnTerminate:=true; thread.Start; end; //////////////////////////////////////////// procedure TFormMain.InitDllEvt(FromFile:String;FormID:Integer;Para:String;FormType:Integer; Title: String; Def1: String; Def2: String; Def3: String; Def4: String; Def5: String; Def6: String; Def7: String; Def8: String; Def9: String; Def10: string); 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 Th: HMODULE; Tp: TFarProc; Tf: TMyFunc; begin Th := LoadLibrary(PChar(FromFile)); if Th > 0 then begin TP := GetProcAddress(Th, PAnsichar(AnsiString('GetDllForm'))); if TP <> nil then begin Tf := TMyFunc(Tp); Tf(Application, 0, FormID, 0, FormType, PChar(User_Id), PChar(User_name), PChar(Para), PChar(Title), PChar(Def1), PChar(Def2),PChar(Def3),PChar(Def4),PChar(Def5), PChar(Def6),PChar(Def7),PChar(Def8),PChar(Def9),PChar(Def10), pchar(ConDateBaseString)); end; end else begin Application.MessageBox(PChar('打不开文件' + FromFile + '!'), '错误', MB_ICONERROR); end; end; end.