为什么服务运行后无法关机

anyqu 2010-05-29 09:20:50
前段时间做了一个数据处理的服务。后来用户反应程序运行后正常关机关不上。找了一天也没有找到原因！求各位大虾给看看！
服务代码


unit LMS;



interface



uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,Unit_FrmMain,WinSvc,registry,IniFiles;

type

  THC_LMS_Service = class(TService)

  procedure ServiceContinue(Sender: TService; var Continued: Boolean);

  procedure ServiceExecute(Sender: TService);

  procedure ServicePause(Sender: TService; var Paused: Boolean);

  procedure ServiceShutdown(Sender: TService);

  procedure ServiceStart(Sender: TService; var Started: Boolean);

  procedure ServiceStop(Sender: TService; var Stopped: Boolean);

    procedure ServiceAfterInstall(Sender: TService);

  procedure SetDescription;

  private

    { Private declarations }

  public

    function GetServiceController: TServiceController; override;

        { Public declarations }

  end;



var

  HC_LMS_Service: THC_LMS_Service;

  frmMain:TfrmMain;

implementation



{$R *.DFM}



procedure ServiceController(CtrlCode: DWord); stdcall;

begin

  HC_LMS_Service.Controller(CtrlCode);

end;



function THC_LMS_Service.GetServiceController: TServiceController;

begin

  Result := ServiceController;

end;



procedure THC_LMS_Service.ServiceContinue(Sender: TService;

var Continued: Boolean);

begin

//  while not Terminated do

//  begin

//    Sleep(10);

//    ServiceThread.ProcessRequests(False);

//  end;

end;



procedure THC_LMS_Service.ServiceExecute(Sender: TService);

begin

//  while not Terminated do

//  begin

//    Sleep(10);

//    ServiceThread.ProcessRequests(False);

//  end;

end;



procedure THC_LMS_Service.ServicePause(Sender: TService;

var Paused: Boolean);

begin

  Paused := True;

end;



procedure THC_LMS_Service.ServiceShutdown(Sender: TService);

begin

  gbCanClose := true;

  //FrmMain.Free;

  Status := csStopped;

  ReportStatus();

end;

/// <example>

/// <code>

/// 启动服务

/// </code>

/// </example>

procedure THC_LMS_Service.ServiceStart(Sender: TService;var Started: Boolean);

begin

  Started := True;

  //Svcmgr.Application.CreateForm(TFrmMain, FrmMain);

  gbCanClose := False;

  //读配置文件

  // frmMain.T_pro.Enabled

  //FrmMain.Hide;

end;



procedure THC_LMS_Service.ServiceStop(Sender: TService;

var Stopped: Boolean);

begin

  Stopped := True;

  gbCanClose := True;

  //FrmMain.Free;

end;

 procedure THC_LMS_Service.ServiceAfterInstall(Sender: TService);

 begin

   // 设置服务描述信息

   self.SetDescription;

 end;



procedure THC_LMS_Service.SetDescription;

var

   reg:TRegistry;//注册表对象

   ConfigIni:TIniFile;

   Desc:string;

begin

  ConfigIni :=TIniFile.Create('LMS_Config.ini');

  reg:=tregistry.create;

  try

    Desc :=ConfigIni.ReadString('Appinfo','Description','华创公司数据处理程序');

    if Desc <>'' then

    begin

      reg.rootkey:=HKEY_LOCAL_MACHINE;

      with reg do

      begin

        if KeyExists('SYSTEM\\ControlSet001\\Services\\HC_LMS_Service') then

        begin

          if OpenKey('SYSTEM\\ControlSet001\\Services\\HC_LMS_Service',True) then

          begin

            WriteString('Description',Desc);



          end;

        end;

      end;

    end;

  finally

    Reg.CloseKey;

    reg.Free ;

    ConfigIni.Free;

  end;

end;

end.

...全文
393 19 打赏 收藏 转发到动态 举报
写回复
用AI写文章
19 条回复
切换为时间正序
请发表友善的回复…
发表回复
colinxu1 2010-07-08
  • 打赏
  • 举报
 回复
不知道这位兄弟的问题是否已经得到解决，之前我也做过一个服务程序，也出现如楼主相同的问题，在关机时总是不能关掉，最后的解决方法是这样的：
在private中增加方法winexit具体方法名可以自行定义，
procedure winexit(var msg:Tmessage);message WM_QUERYENDSESSION;
对方法的具体内容如下
procedure TForm1.winexit(var msg: Tmessage);
begin
{可以写一些自己要执行的代码}
Msg.Result := 1;//允许系统关机或重启
end;
而这个方法不需要任何手动调用，加上后编译再启动服务就可以正常关机了。
希望还能够解决楼主的问题
dinoalex 2010-06-01
  • 打赏
  • 举报
 回复
// TFrmMain 加消息处理声明
procedure WMQueryEndSession (var Message: TMessage); message WM_QUERYENDSESSION;
dinoalex 2010-06-01
  • 打赏
  • 举报
 回复
之前我也遇到这情况, 下面是解决办法

[Code=Delphi(Pascal)]
procedure THC_LMS_Service.ServiceExecute(Sender: TService);
begin
while not Terminated do
begin
sleep(10);
if SetCanClose then // setCanClose 是 LMS 的全局变量 初始为 false (在create时)
begin
HC_LMS_Service.DoStop;
Free;
end
else
ServiceThread.ProcessRequests(False);
end;
end;

procedure THC_LMS_Service.ServiceShutdown(Sender: TService);
begin
Status := csStopped;
ReportStatus();
end;

// TFrmMain 加消息处理 WMQueryEndSession(var Message: TMessage);
//

procedure TFrmMain.WMQueryEndSession(var Message: TMessage);
begin
SetCanClose := True; // LMS 的变量
inherited;
end;

procedure TFrmMain.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
CanClose:= SetCanClose;
if not CanClose then Hide;
end;
[/Code]
SQLDebug_Fan 2010-06-01
  • 打赏
  • 举报
 回复
可能是这个里面的问题，你需要把服务线程退出，有问题的代码：


procedure THC_LMS_Service.ServiceStop(Sender: TService;

var Stopped: Boolean);

begin

  Stopped := True;

  gbCanClose := True;

  //FrmMain.Free;

end;
anyqu 2010-06-01
  • 打赏
  • 举报
 回复
procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := gbCanClose;
if not CanClose then
begin
Hide;
end;
end;

这里的问题
加个状态判断
--------------------------------------------
procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := gbCanClose;
if Sender=nil then CanClose := True;
if not CanClose then
begin
Hide;
end;
end;

------------------------------------------------------
不好使，没有反应

if Sender=nil then CanClose := True;
SQLDebug_Fan 2010-06-01
  • 打赏
  • 举报
 回复
这种情况有可能是系统给你发了退出消息，你没有给系统返回，按dinoalex的办法，把WM_QUERYENDSESSION消息处理一下。
yxuxueying 2010-06-01
  • 打赏
  • 举报
 回复
先把软件退出呗
anyqu 2010-05-31
  • 打赏
  • 举报
 回复
to:sparklerl
"你截获了系统消息,没处理的时候是不是没还给系统啊"
这句从何说起呀？我用消息是为了托盘菜单，没有接获其他的系统消息呀！
CaesarDM 2010-05-31
  • 打赏
  • 举报
 回复
procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := gbCanClose;
if not CanClose then
begin
Hide;
end;
end;

这里的问题
加个状态判断
if Sender=nil then CanClose := True;
yct0605 2010-05-31
  • 打赏
  • 举报
 回复
用户关机的时候是否先退出了软件，可以在这个方面进行查找看。
yct0605 2010-05-31
  • 打赏
  • 举报
 回复
这还有意思啊，代码应该可以正常关机才对啊！
anyqu 2010-05-29
  • 打赏
  • 举报
 回复
to:SQLDebug_Fan

关掉后可正常关机！
SQLDebug_Fan 2010-05-29
  • 打赏
  • 举报
 回复
把服务停掉能关机吗？
hongss 2010-05-29
  • 打赏
  • 举报
 回复
没什么系统底层的东西，不太可能关不了啊
anyqu 2010-05-29
  • 打赏
  • 举报
 回复
窗体代码续


//新发送程序

procedure TfrmMain.T_proTimer(Sender: TObject);

var

  ConfigIni:TIniFile;

  txt:TextFile;

begin

  if ADOQuery1.Eof then

    ReadNewRecord;

  if ADOQuery1.RecordCount >0 then

  begin

    //更新车号

    ADOQuery2.Close;

    ADOQuery2.SQL.Clear;

    ADOQuery2.SQL.Add('select * from TargetTable Where VarTag=''CH''');

    ADOQuery2.Open;

    ADOQuery2.Edit;

    ADOQuery2.FieldByName('Value').AsString :=ADOQuery1.fieldByName('truckno').AsString;

    ADOQuery2.Post;

    label1.Caption:='[过衡车号]：'+ADOQuery2.FieldByName('Value').AsString ;

    //更新时间

    ADOQuery2.Close;

    ADOQuery2.SQL.Clear;

    ADOQuery2.SQL.Add('select * from TargetTable Where VarTag=''RQ''');

    ADOQuery2.Open;

    ADOQuery2.Edit;

    ADOQuery2.FieldByName('Value').AsString :=ADOQuery1.fieldByName('grossdatetime').AsString;

    ADOQuery2.Post;

    label2.Caption:='[过衡时间]：'+ADOQuery2.FieldByName('Value').AsString ;

    //货物名

    ADOQuery2.Close;

    ADOQuery2.SQL.Clear;

    ADOQuery2.SQL.Add('select * from TargetTable Where VarTag=''PM''');

    ADOQuery2.Open;

    ADOQuery2.Edit;

    ADOQuery2.FieldByName('Value').AsString :=ADOQuery1.fieldByName('product').AsString;

    ADOQuery2.Post;

    label3.Caption:='[货品名称]：'+ADOQuery2.FieldByName('Value').AsString ;

    //皮重

    ADOQuery2.Close;

    ADOQuery2.SQL.Clear;

    ADOQuery2.SQL.Add('select * from TargetTable Where VarTag=''PZ''');

    ADOQuery2.Open;

    ADOQuery2.Edit;

    ADOQuery2.FieldByName('Value').AsString :=ADOQuery1.fieldByName('tare').AsString;

    ADOQuery2.Post;

    label4.Caption:='[皮重]：'+ADOQuery2.FieldByName('Value').AsString ;

    //毛重

    ADOQuery2.Close;

    ADOQuery2.SQL.Clear;

    ADOQuery2.SQL.Add('select * from TargetTable Where VarTag=''MZ''');

    ADOQuery2.Open;

    ADOQuery2.Edit;

    ADOQuery2.FieldByName('Value').AsString :=ADOQuery1.fieldByName('gross').AsString;

    ADOQuery2.Post;

    label5.Caption:='[毛重]：'+ADOQuery2.FieldByName('Value').AsString ;

    //净重

    ADOQuery2.Close;

    ADOQuery2.SQL.Clear;

    ADOQuery2.SQL.Add('select * from TargetTable Where VarTag=''JZ''');

    ADOQuery2.Open;

    ADOQuery2.Edit;

    if  ADOQuery1.fieldByName('net').AsString=''  then

      ADOQuery2.FieldByName('Value').AsString :='0'

    else

      ADOQuery2.FieldByName('Value').AsString :=ADOQuery1.fieldByName('net').AsString;

    ADOQuery2.Post;

    label6.Caption:='[净重]：'+ADOQuery2.FieldByName('Value').AsString ;

    ConfigIni:=TIniFile.Create('LMS_Config.ini');

    ConfigIni.WriteInteger('CurrentCount','Count',ADOQuery1.fieldByName('ID').AsInteger);

    ConfigIni.Free;

    StatusBar1.Panels[1].Text :='当前序号：'+ ADOQuery1.fieldByName('ID').AsString ;

    //添加到Memo1

    Memo1.Lines.Add('/#/   '  +Label1.Caption +'     '+Label3.Caption +'   /#/');

    Memo1.Lines.add('/#/   '  +Label4.Caption +'     '+Label5.Caption+'     '+Label6.Caption+'   /#/');

    Memo1.Lines.add('/#/   '  +Label2.Caption +'   /#/');

    Memo1.lines.add('-------------------------------------------------------------');



    Label1.Font.Color :=clBlue;

    Label2.Font.Color :=clBlue;

    Label3.Font.Color :=clBlue;

    Label4.Font.Color :=clBlue;

    Label5.Font.Color :=clBlue;

    Label6.Font.Color :=clBlue;

    try

        //写历史文件

      if FileExists(HistoryPath+'H'+FormatDateTime('yyyymmdd',Date)+'.htf') then

      begin

        AssignFile(txt, HistoryPath+'H'+FormatDateTime('yyyymmdd',Date)+'.htf');

        Append(txt);

      end

      else

      begin

        AssignFile(txt, HistoryPath+'H'+FormatDateTime('yyyymmdd',Date)+'.htf');

        Rewrite(txt);

      end;

      Writeln(txt,'/#/   '  +Label1.Caption +'     '+Label3.Caption +'   /#/');

      Writeln(txt,'/#/   '  +Label4.Caption +'     '+Label5.Caption+'     '+Label6.Caption+'   /#/');

      Writeln(txt,'/#/   '  +Label2.Caption +'   /#/');

      Writeln(txt,'-------------------------------------------------------------');

      CloseFile(txt);

      ADOQuery1.Next;

    except

      on E:Exception do

      begin

         Memo2.Lines.Add('写日志文件出错，详细信息:'+E.Message);

         Memo2.LineS.add('----------------------------------------');

      end;

    end;

    Application.ProcessMessages;

  end

  else

  begin    //查不到后更改车号为 0

    //更新车号

    ADOQuery2.Close;

    ADOQuery2.SQL.Clear;

    ADOQuery2.SQL.Add('select * from TargetTable Where VarTag=''CH''');

    ADOQuery2.Open;

    ADOQuery2.Edit;

    ADOQuery2.FieldByName('Value').AsString :='0';

    ADOQuery2.Post;

    if N2.Checked=False  then

    begin

      Label1.Caption :='[过衡车号]：'+ADOQuery1.FieldByName('truckno').AsString;

      Label1.Font.Color :=clRed;

      Label2.Caption :='[过衡时间]：'+ADOQuery1.FieldByName('grossdatetime').AsString;

      Label2.Font.Color :=clRed;

      Label3.Caption :='[货品名称]：'+ADOQuery1.FieldByName('product').AsString;

      Label3.Font.Color :=clRed;

      Label4.Caption :='[皮重]：'+ADOQuery1.FieldByName('tare').AsString;

      Label4.Font.Color :=clRed;

      Label5.Caption :='[毛重]：'+ADOQuery1.FieldByName('gross').AsString;

      Label5.Font.Color :=clRed;

      Label6.Caption :='[净重]：'+ADOQuery1.FieldByName('net').AsString;

      Label6.Font.Color :=clRed;

    end;

  end;

end;



//用这个可以停止服务，可是用户希望直接点关机按钮就可以关机不需要先关程序（傻瓜操作）

procedure TfrmMain.T1Click(Sender: TObject);

var

  BatFilename :string;

  BatchFile:   TextFile;

begin

  BatFilename:=ExtractFilePath(Application.ExeName)+   'AutoStop.bat ';//批处理文件名称

  assignfile(BatchFile,BatFilename);

  rewrite(BatchFile);

  writeln(BatchFile, 'Net Stop HC_LMS_SERVICE ');

  writeln(BatchFile, '@del   %0 ');

  closefile(BatchFile);

  winexec(pchar(BatFilename),sw_hide);//隐藏窗口运行a.bat

  application.Terminate;//退出程序

end;



procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  T1.Click;

end;



end.
sanguomi 2010-05-29
  • 打赏
  • 举报
 回复
这段代码应该不太可能使别人不能关机
anyqu 2010-05-29
  • 打赏
  • 举报
 回复
窗体代码




unit Unit_FrmMain;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms,

Dialogs, ExtCtrls, StdCtrls, Menus, ComCtrls, ImgList,IniFiles, DB, ADODB,WinSvc;



const

WM_TrayIcon = WM_USER + 1234;



type

  TfrmMain = class(TForm)

    StatusBar1: TStatusBar;

    T_pro: TTimer;

    ADOConnection1: TADOConnection;

    ADOConnection2: TADOConnection;

    ADOQuery1: TADOQuery;

    ADOQuery2: TADOQuery;

    PageControl1: TPageControl;

    TabSheet1: TTabSheet;

    TabSheet2: TTabSheet;

    Memo1: TMemo;

    Memo2: TMemo;

    MainMenu1: TMainMenu;

    N1: TMenuItem;

    N2: TMenuItem;

    N3: TMenuItem;

    N4: TMenuItem;

    N6: TMenuItem;

    N7: TMenuItem;

    PopupMenu1: TPopupMenu;

    N8: TMenuItem;

    N9: TMenuItem;

    N10: TMenuItem;

    GroupBox1: TGroupBox;

    Label1: TLabel;

    Label2: TLabel;

    Label3: TLabel;

    Label4: TLabel;

    Label5: TLabel;

    Label6: TLabel;

    T_Ico: TTimer;

    E1: TMenuItem;

    T1: TMenuItem;

    procedure FormCreate(Sender: TObject);

    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

    procedure FormDestroy(Sender: TObject);

    procedure N4Click(Sender: TObject);

    procedure N2Click(Sender: TObject);

    procedure N8Click(Sender: TObject);

    procedure N9Click(Sender: TObject);

    procedure N7Click(Sender: TObject);

    procedure T_proTimer(Sender: TObject);

    procedure T1Click(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private

    { Private declarations }

    IconData: TNotifyIconData;

    procedure AddIconToTray;

    procedure DelIconFromTray;

    procedure TrayIconMessage(var Msg: TMessage); message WM_TrayIcon;

    procedure SysButtonMsg(var Msg: TMessage); message WM_SYSCOMMAND;

    procedure ReadConfigInfo;

  public

    { Public declarations }

    ///配置文件信息变量

    AppName,Desc,SDB,TDB,LogFile,HistoryPath:string;

    TimeSet:Integer;

    procedure SetApplicationLog(DateTime,Info:string);

    procedure ReadNewRecord();

  end;



var

  frmMain: TfrmMain;

  gbCanClose: Boolean;



implementation



uses LMS;



{$R *.dfm}

/// <example>

/// <code>

/// 字符串分割函数

/// </code>

/// </example>

function Split(sourceString,Splitchar:string):TStringList;

begin

  Result :=TStringList.Create;

  //showmessage(Inttostr(Pos(sourceString,Splitchar)));

  while Pos(Splitchar,sourceString)>0 do

  begin

    Result.Add(Copy(sourceString,1,Pos(Splitchar,sourceString)-1));

    Delete(sourceString,1, Pos(Splitchar,sourceString));

  end;

  Result.Add(sourceString);

end;

/// <example>

/// <code>

/// 读取配置文件信息

/// </code>

/// </example>

procedure TFrmMain.ReadConfigInfo;

var

   ConfigIni:TIniFile;

begin

  ConfigIni :=TIniFile.Create('LMS_Config.ini');

  AppName:=ConfigIni.ReadString('Appinfo','Name','数据处理程序');

  Desc:=ConfigIni.ReadString('Appinfo','Description','数据处理程序');

  SDB :=ConfigIni.ReadString('DataSet','SDB','');   //源数据库链接

  TDB  :=ConfigIni.ReadString('DataSet','TDB','');  //目标数据库链接

  TimeSet := ConfigIni.ReadInteger('TimeSet','Time',10);  //取数据时间设置

  HistoryPath:= ConfigIni.ReadString('History','Path','D:\');

  LogFile :=ConfigIni.ReadString('LogSet','LogFile','D:\LMS_Log.log');   //日志文件路径

  ConfigIni.Free;

end;

procedure TFrmMain.FormCreate(Sender: TObject);

begin

  ReadConfigInfo;

  frmMain.Caption :=AppName;

  FormStyle := fsStayOnTop; {窗口最前}

  SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW); {不在任务栏显示}

  gbCanClose := False;

  T_pro.Enabled :=False;

  DelIconFromTray;

  AddIconToTray;

  //创建历史文件目录

  if HistoryPath =''  then

    HistoryPath :='D:\';

  if DirectoryExists(HistoryPath) =False then

    CreateDirectory(PChar(HistoryPath),nil);

  try

    ADOConnection1.ConnectionString:=SDB;

    ADOConnection1.Connected :=true;

    ADOQuery1.Close;

    ADOQuery1.SQL.Clear;

    ADOQuery1.SQL.Add('SELECT Top 1 * FROM TRADE');

    ADOQuery1.Open;

    Memo2.Lines.Add('[ '+DateTimeToStr(Date)+FormatDateTime('hh:nn:ss',Now())+' ] 初始化连接源数据库成功');

    Memo2.Lines.Add('----------------------------------------');

    SetApplicationLog(DateTimeToStr(Date)+' '+FormatDateTime('hh:nn:ss',Now()),'初始化连接源数据库成功');

    ADOQuery1.Close;

    ADOConnection2.ConnectionString:=TDB;

    ADOConnection2.Connected  :=True;

    ADOQuery2.Close;

    ADOQuery2.SQL.Clear;

    ADOQuery2.SQL.Add('SELECT * FROM TargetTable');

    ADOQuery2.Open;

    Memo2.Lines.Add('[ '+DateTimeToStr(Date)+FormatDateTime('hh:nn:ss',Now())+' ] 初始化连接目标数据库成功');

    Memo2.Lines.Add('----------------------------------------');

    SetApplicationLog(DateTimeToStr(Date)+' '+FormatDateTime('hh:nn:ss',Now()),'初始化连接目标数据库成功');

    ADOQuery2.Close;

    T_pro.Enabled :=True;

    T_pro.Interval :=TimeSet*1000;

    //读新数据

    ReadNewRecord;

  except

    on E:Exception do

    begin

      Memo2.Lines.Add('[ '+DateTimeToStr(Date)+FormatDateTime('hh:nn:ss',Now())+' ] 初始化数据环境出错。');

      Memo2.Lines.Add('详细信息：'+e.Message);

      Memo2.Lines.Add('----------------------------------------') ;

      SetApplicationLog(DateTimeToStr(Date)+' '+FormatDateTime('hh:nn:ss',Now()),'初始化数据环境出错。详细信：'+e.Message);

    end;

  end;

end;



procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

  CanClose := gbCanClose;

  if not CanClose then

  begin

    Hide;

  end;

end;



procedure TFrmMain.FormDestroy(Sender: TObject);

begin

  ADOConnection1.Connected :=false;

  ADOConnection2.Connected :=false;

  DelIconFromTray;

end;

/// <example>

/// <code>

/// 添加托盘图标

/// </code>

/// </example>

procedure TFrmMain.AddIconToTray;

begin

  ZeroMemory(@IconData, SizeOf(TNotifyIconData));

  IconData.cbSize := SizeOf(TNotifyIconData);

  IconData.Wnd := Handle;

  IconData.uID := 1;

  IconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;

  IconData.uCallbackMessage := WM_TrayIcon;

  IconData.hIcon := Application.Icon.Handle;

  IconData.szTip := '地衡数据处理程序';

  Shell_NotifyIcon(NIM_ADD, @IconData);

end;



procedure TFrmMain.DelIconFromTray;

begin

  Shell_NotifyIcon(NIM_DELETE, @IconData);

end;



procedure TFrmMain.SysButtonMsg(var Msg: TMessage);

begin

  if (Msg.wParam = SC_CLOSE) or (Msg.wParam = SC_MINIMIZE) then

    Hide

  else inherited; // 执行默认动作

end;



procedure TFrmMain.TrayIconMessage(var Msg: TMessage);

var

  p:TPoint;

begin

  //双击显示主程序

  if (Msg.LParam = WM_LBUTTONDBLCLK) then

  //Svcmgr.Application.CreateForm(TFrmMain, FrmMain);

    Show();

    //右键显示菜单  为安全性关闭此功能

  if (Msg.LParam =WM_LBUTTONDOWN) then

  begin

    GetCursorPos(p);

    PopupMenu1.Popup(p.x,p.y);

  end;



end;







procedure SendHokKey;stdcall;

var

  HDesk_WL: HDESK;

begin

  HDesk_WL := OpenDesktop ('Winlogon', 0, False, DESKTOP_JOURNALPLAYBACK);

  if (HDesk_WL <> 0) then

    if (SetThreadDesktop (HDesk_WL) = True) then

    PostMessage(HWND_BROADCAST, WM_HOTKEY, 0, MAKELONG (MOD_ALT or MOD_CONTROL, VK_DELETE));

end;



procedure TFrmMain.SetApplicationLog(DateTime,Info:string);

var

  txt:TextFile;

begin

  try

    if FileExists(LogFile) then

    begin

      AssignFile(txt, LogFile);

      Append(txt);

    end

    else

    begin

      AssignFile(txt, LogFile);

      Rewrite(txt);

    end;

    Writeln(txt,DateTime+'-----Info:'+Info);

    CloseFile(txt);

  except

    Application.MessageBox('无法在指定位置创建日志文件，请手工创建！','提示',MB_ICONERROR+MB_OK)

  end;

end;

procedure TfrmMain.N4Click(Sender: TObject);

begin

 N4.Checked :=not N4.Checked ;

 PageControl1.Visible :=N4.Checked ;

 if PageControl1.Visible then

  frmMain.Height :=frmMain.Height+160

  else

  frmMain.Height :=frmMain.Height -160;

end;

procedure TfrmMain.N2Click(Sender: TObject);

begin

  N2.Checked :=not N2.Checked;

end;



procedure TfrmMain.N8Click(Sender: TObject);

begin

  frmMain.Show;

end;



procedure TfrmMain.N9Click(Sender: TObject);

begin

  frmMain.Hide;

end;



procedure TfrmMain.N7Click(Sender: TObject);

begin

  Application.MessageBox('版权所有：大庆开发区华创电子有限公司'+#13+#13'                2010-05-01     ','关于本软件',MB_ICONINFORMATION+MB_OK)

end;

//读取最新数据

procedure TfrmMain.ReadNewRecord;

var

  ConfigIni:TINIFILE;

  xh:LongInt;

  KeyWord:string;

  key :TStringList;

  Wherestr:string;

  i:integer;

begin

  xh:=0;

  try

    ConfigIni :=TIniFile.Create('LMS_Config.ini');

    xh:=ConfigIni.ReadInteger('CurrentCount','Count',1);

    KeyWord := ConfigIni.ReadString('ProductSort','Sort','');

    if KeyWord <>'' then

    begin

      key:=Split(KeyWord,',');



       for i:=0 to key.Count -1 do

       begin

         wherestr:=Wherestr + ' or product ='''+ key[i]+'''';

       end;



      Delete(Wherestr,1,3);

      ADOQuery1.Close;

      ADOQuery1.SQL.Clear;

      ADOQuery1.SQL.Add('Select * FROM TRADE WHERE  '+Wherestr+' And ID>'+intTostr(xh)+' order by ID');

      ADOQuery1.Open;

      ConfigIni.Free;

      ADOQuery1.First;

    end ;

  except

    on e:Exception do

    begin

      if Memo2.Lines.Count >10 then

        Memo2.Lines.Clear;

      Memo2.Lines.Add(DateToStr(Date)+' '+FormatDateTime('hh:nn:ss',Now())+'--------编号:['+InttoStr(xh)+']  数据处理过程中出现错误。详细信息如下：'+e.Message);

      SetApplicationLog(DateToStr(Date)+' '+FormatDateTime('hh:nn:ss',Now()),'编号:['+InttoStr(xh)+']  数据处理过程中出现错误。详细信息如下：'+e.Message);

    end;

  end;

end;
aluyue 2010-05-29
  • 打赏
  • 举报
 回复
MARK 偶之前也遇到。。。。。。顶起来
sparklerl 2010-05-29
  • 打赏
  • 举报
 回复
你截获了系统消息,没处理的时候是不是没还给系统啊
腾讯云服务器关机了登不上,腾讯云服务器可以关机或者重启操作不？
在运维腾讯云服务器的过程中，有时候因为实际业务的要求或者系统更新的...对腾讯云服务器的关机以及重启操作一般有以下几个方法：(1)远程上服务器后进行关机重启操作如果是Windows服务器，可以使用Windows远程桌面等...
服务器系统怎么关机,服务器怎么关机了
服务器怎么关机了 内容精选换一换如果对弹性云服务器执行重启/关机操作，弹性云服务器长时间(大于30分钟)处于“正在重启”/“正在关机”状态时，建议执行强制重启/强制关机操作。登录管理控制台。单击管理控制台左上...
如何查看服务器关机日志信息,查看服务器关机日志
查看服务器关机日志 内容精选换一换为加强对系统数据的容灾管理，云堡垒机支持配置日志备份，提高审计数据安全性和系统可扩展性。本小节主要介绍如何在系统配置Syslog服务器参数，将日志远程备份至Syslog服务器。...
linux进程占用无法关机,统信UOS20个人版无法关机和重启的解决方法
方法一：通过bios设置来解决统信UOS个人版无法关机和重启的问题通过U盘安装统信UOS20个人版，在完成系统安装后(已拔出U盘)，遇到无法关机和重启问题，尝试以下方法得到解决：1、在开机时按F2(根据各自电脑情况)键，...
解决 Ubuntu 18.04 无法关机的问题
之前我学习了 Celery ，使用了 rabbitmq ，这玩艺是生产级别的消息中间人，果然够强悍，竟然关机程序都无法阻止他。 解决问题 rabbitmq-server 一般是运行在服务器上的，个人电脑无所谓了，直接禁止开机启动，再停止...
Delphi

5,507

社区成员

262,734

社区内容

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章