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

Question

前段时间做了一个数据处理的服务。后来用户反应程序运行后正常关机关不上。找了一天也没有找到原因！求各位大虾给看看！
服务代码unit LMS;interfaceuses
  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.

Answer 1

窗体代码
unit Unit_FrmMain;interfaceuses
  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;implementationuses 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;

Answer 2

窗体代码续//新发送程序
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.

Answer 3

to:SQLDebug_Fan关掉后可正常关机！

Answer 4

to:sparklerl 
"你截获了系统消息,没处理的时候是不是没还给系统啊"
这句从何说起呀？我用消息是为了托盘菜单，没有接获其他的系统消息呀！

Answer 5

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;

Answer 6

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;

Answer 7

可能是这个里面的问题，你需要把服务线程退出，有问题的代码：procedure THC_LMS_Service.ServiceStop(Sender: TService;
var Stopped: Boolean);
begin
  Stopped := True;
  gbCanClose := True;
  //FrmMain.Free;
end;

Answer 8

之前我也遇到这情况, 下面是解决办法
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;

Answer 9

// TFrmMain 加消息处理声明
procedure WMQueryEndSession (var Message: TMessage); message WM_QUERYENDSESSION;

Answer 10

这种情况有可能是系统给你发了退出消息，你没有给系统返回，按dinoalex的办法，把WM_QUERYENDSESSION消息处理一下。

Answer 11

不知道这位兄弟的问题是否已经得到解决，之前我也做过一个服务程序，也出现如楼主相同的问题，在关机时总是不能关掉，最后的解决方法是这样的：
在private中增加方法winexit具体方法名可以自行定义， 
procedure winexit(var   msg:Tmessage);message   WM_QUERYENDSESSION; 
对方法的具体内容如下
procedure   TForm1.winexit(var msg: Tmessage); 
begin 
    {可以写一些自己要执行的代码}
    Msg.Result := 1;//允许系统关机或重启       
end; 
而这个方法不需要任何手动调用，加上后编译再启动服务就可以正常关机了。
希望还能够解决楼主的问题