从网上找的例子,源来的忘了,记得最开始是一个图标,后来不知道为什么出现了两个图标。当服务停止时就报错,一个的时候没有报错!请大侠们帮忙看看!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.
unit Unit_FrmMain;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Menus, ComCtrls, ImgList,IniFiles, DB, ADODB,
  Grids, DBGrids;const
WM_TrayIcon = WM_USER + 1234;type
  TfrmMain = class(TForm)
    StatusBar1: TStatusBar;
    T_pro: TTimer;
    Memo1: TMemo;
    ADOConnection1: TADOConnection;
    ADOConnection2: TADOConnection;
    ADOQuery1: TADOQuery;
    ADOQuery2: TADOQuery;
    DataSource1: TDataSource;
    DataSource2: TDataSource;
    DBGrid1: TDBGrid;
    DBGrid2: TDBGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure T_proTimer(Sender: TObject);
    //procedure Button1Click(Sender: TObject);
  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,LogFilePath:string;
    TimeSet:Integer;
    procedure SetApplicationLog(ErrorTime,ErrorInfo:string);
  end;var
  frmMain: TfrmMain;
  gbCanClose: Boolean;implementationuses LMS;{$R *.dfm}
/// <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',1);  //取数据时间设置
  LogFilePath :=ConfigIni.ReadString('Appinfo','LogFilePath','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;
  AddIconToTray;
  //SetApplicationLog(DateTimeToStr(Date),'程序启动');
  try
    ADOConnection1.ConnectionString:=SDB;
    ADOConnection1.Connected :=true;
    ADOQuery1.Close;
    ADOQuery1.SQL.Clear;
    ADOQuery1.SQL.Add('SELECT * FROM ST');
    ADOQuery1.Open;
    SetApplicationLog(DateTimeToStr(Date),'初始化连接目标数据库成功');
    ADOConnection2.ConnectionString:=TDB;
    ADOConnection2.Connected  :=True;
    ADOQuery2.Close;
    ADOQuery2.SQL.Clear;
    ADOQuery2.SQL.Add('SELECT * FROM TT');
    ADOQuery2.Open;
    SetApplicationLog(DateTimeToStr(Date),'初始化连接目标数据库成功');
    T_pro.Enabled :=True;
    T_pro.Interval :=TimeSet*1000;
    
  except
    on E:Exception do
      SetApplicationLog(DateTimeToStr(Date),'初始化数据环境出错。详细信:'+e.Message);
  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
    Show();
    //右键显示菜单  为安全性关闭此功能
//  if (Msg.LParam =WM_RBUTTONDOWN) then
//  begin
//    GetCursorPos(p);
//    PopupMenu1.Popup(p.x,p.y);
//  end;end;procedure TFrmMain.Timer1Timer(Sender: TObject);
begin
 // AddIconToTray;
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;
/// <example>
/// <code>
/// 数据处理程序
/// </code>
/// </example>
procedure TfrmMain.T_proTimer(Sender: TObject);
begin
  try
    ADOQuery1.Close;
    ADOQuery1.SQL.Clear;
    ADOQuery1.SQL.Add('Select * FROM ST');
    ADOQuery1.Open;
    if ADOQuery1.RecordCount =1 then
    begin
      ADOQuery2.Close;
      ADOQuery2.SQL.Clear;
      ADOQuery2.SQL.Add('select * from TT Where Item=''CH''');
      ADOQuery2.Open;
      ADOQuery2.Edit;
      ADOQuery2.FieldByName('Item_Value').AsString :=ADOQuery1.fieldByName('CH').AsString;
      ADOQuery2.Post;
      StatusBar1.Panels[1].Text :='数据处理中...'+ADOQuery2.FieldByName('Item_Value').AsString ;
    end;
  except
    on e:Exception do
    begin
      if Memo1.Lines.Count >10 then
        Memo1.Lines.Clear;
        Memo1.Lines.Add(DateToStr(Date)+' '+FormatDateTime('hh:nn:ss',Now())+'--------数据处理过程中出现错误。详细信息如下:'+e.Message);
      SetApplicationLog(DateToStr(Date)+' '+FormatDateTime('hh:nn:ss',Now()),'数据处理过程中出现错误。详细信息如下:'+e.Message);
    end;
  end;
end;
/// <example>
/// <code>
/// 日志记录方法
/// </code>
/// </example>
procedure TFrmMain.SetApplicationLog(ErrorTime,ErrorInfo:string);
var
  txt:TextFile;
begin
  try
    AssignFile(txt, LogFilePath);
    Append(txt);
    Writeln(txt,'ErrorTime:'+ErrorTime+'-----ErrorInfo:'+ErrorInfo);
    CloseFile(txt);
  finally  end;
end;
end.

解决方案 »

  1.   

    太多了,不想看,不过估计是在没有关掉服务的时候又调用了THC_LMS_Service.ServiceStart(Sender: TService;var Started: Boolean);
    函数。
      

  2.   

    可以试试在TIMER里面做这样的处理:除去TRAYICON再建TRAYICON
      

  3.   

    一开始以为是SERVER一个图标,窗体一个,可是把窗体的样试设为对话框后运行,还是显示两个图标,真是怪事!