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; 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; 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); private { Private declarations } function intiData(): Boolean; procedure GetServerDate(); public ConDateBaseString: string; V_User, V_UserID, User_Id, User_Name: string; { Public declarations } // server, dtbase, user, pswd: String; end; var FormMain: TFormMain; gServerDate: TdateTime; server, dtbase, user, pswd: string; {数据库连接参数} gConString: string; {全局连接字符串} gCurHandle: hwnd; //当前窗体句柄 newh: hwnd; CriticalSection: TCriticalSection; {声明临界} implementation uses logon, U_Link, U_iniParam; {$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 := FormMain.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); var tmpstr: string; begin CriticalSection := TCriticalSection.Create; if IsINIFile() then ReadINIFile() else WriteINIFile; 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); var XSStr: string; begin try IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'YEInspFile.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', '1'); if XSStr = '1' then begin Panel3.Visible := True; end else begin Panel3.Visible := False; end; finally IniFile.Free; end; 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; xx: string; 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; } try IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'YEInspFile.INI'); DllName := IniFile.ReadString('生产车间配置', 'DLL文件1', 'TradeManagePB.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'); Tp := GetProcAddress(Th, PAnsichar(AnsiString('GetDllForm'))); if Tp <> nil then begin Tf := TMyFunc(Tp); Tf(Application, 0, strtoint(DllInt), 0, 0, PChar(User_Id), PChar(User_Name), PChar(xx), PChar('55'), PChar(xx), PChar(xx), PChar(xx), PChar(xx), PChar(xx), PChar(xx), PChar(xx), PChar(xx), pchar(xx), PChar(xx), 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 //静态加载 //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; } try IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'YEInspFile.INI'); DllName := IniFile.ReadString('生产车间配置', 'DLL文件2', 'TradeManagePB.dll'); DllInt := IniFile.ReadString('生产车间配置', 'DLL调用号2', '301'); 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(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.Timer_linkTimer(Sender: TObject); begin TMyThread.Create(False); end; procedure TFormMain.FormDestroy(Sender: TObject); begin CriticalSection.Free; end; end.