Delphi ScktSrvr.exe程序修改版

最新推荐文章于 2023-05-01 02:50:02 发布

原创最新推荐文章于 2023-05-01 02:50:02 发布 · 4k 阅读

1 ·

本内容遵循CC 4.0 BY-SA版权协议

标签

#delphi #Delphi #DELPHI

DEPHI 专栏收录该内容

21 篇文章

订阅专栏

该博客介绍了如何修改Delphi的ScktSrvr.exe程序，以解决Com+组件调用失败导致Socket Server挂起的问题。当调用超过特定时间未响应时，程序会自动关闭COM+组件服务，结束挂起的客户端调用。客户端设计应具备重试机制，能在重新连接后恢复调用，而COM+组件服务会在需要时自动启动。

先贴图片

看到了吗？图片中的红色部分就是增加的部分。

说说目的：有一种情况下，Com+组件调用失败，导致socket Server挂起，如果不关闭一下COM+组件服务，则所有的客户端调用则会挂起。

为了处理这种情况，在socket Server中调用COM+组件中的某方法超过某个时间没有返回时，关闭一下COM+组件服务。

当COM+组件服务关闭的时候，之前所有挂起的客户端调用将被Kill掉。客户端调用应该设计为可以重试调用，当客户端重新连接，并调用

COM+组件中的方法时，COM+组件中的服务并为自动启动。

procedure TSocketForm.AddClient(Thread: TServerClientThread);
var
  Item: TListItem;
  sTime: String;
  ttime: TDateTime;
begin
  //**********************************************************************
  //前次调用超时,则关闭COM+组件,下次客户端连接时会自动开启COM+组件fhb2012.04.19
  if (ConnectionList.Items.Count > 0)  and (speSecond.Value <> 0) then
  begin
    sTime := ConnectionList.Items[0].SubItems[2];
    ttime := EncodeDateTime(StrToInt(copy(sTime, 1, 4)),
                            StrToInt(Copy(sTime, 6, 2)),
                            StrToInt(Copy(sTime, 9, 2)),
                            StrToInt(Copy(sTime, 12, 2)),
                            StrToInt(Copy(sTime, 15, 2)),
                            StrToInt(Copy(sTime, 18, 2)),
                            0);
    assert(sTime = formatdatetime('yyyy-mm-dd hh:mm:ss', ttime));
    if SecondsBetween(Now, ttime) >= speSecond.Value  then
      StartCOMService('mycom+', false);
  end;

  //**********************************************************************
  Item := ConnectionList.Items.Add;
  Item.Caption := IntToStr(Thread.ClientSocket.LocalPort);
  Item.SubItems.Add(Thread.ClientSocket.RemoteAddress);
  if ShowHostAction.Checked then
  begin
    Item.SubItems.Add(Thread.ClientSocket.RemoteHost);
    if Item.SubItems[1] = '' then Item.SubItems[1] := SHostUnknown;
  end else
    Item.SubItems.Add(SNotShown);

  if Thread is TSocketDispatcherThread then
    //*****************************************************************************************************
    //修改成显示标准格式的日期fhb2012.04.19
    Item.SubItems.Add(FormatDateTime('yyyy-mm-dd hh:mm:ss', TSocketDispatcherThread(Thread).LastActivity));
    //*****************************************************************************************************
  Item.Data := Pointer(Thread);
  UpdateStatus;
end;





unit SfComToolsType;

interface
  uses
    classes;
  type
    TBaseComTools = Tobject;
    TBaseComToolsType = class of TBaseComTools;

implementation

end.




unit SfComTools;

interface

  uses ComObj,SfComToolsType;

type
  TSfComTools = Class(TBaseComTools)
  public
    //安装COM+应用程序
    class function InstallCOMApplication(const aComAppName,aDllName: String):Boolean;stdcall;
    //卸载COM+应用程序
    class function UnInstallCOMApplication(const aComAppName: String):Boolean;stdcall;
    //启动/关闭COM+服务
    class function StartCOMService(const aComAppName: String; const AStart : Boolean):Boolean;stdcall;
  end;

  function GetObjType: TBaseComToolsType;stdcall;

  function StartCOMService(const aComAppName: String; const AStart : Boolean):Boolean;stdcall;


implementation

uses SysUtils;

function GetObjType: TBaseComToolsType;stdcall;
begin
  Result := TSfComTools;
end;

//安装COM+应用程序
class function TSfComTools.InstallCOMApplication(const aComAppName,aDllName: String):Boolean;stdcall;
//const
  //SComApplicationName = '你的应用程序名';
  //SFullDllFileName = 'C:/a.dll';//你的DLL,这里只注册一个DLL
var 
  COMAdminCatalog : OleVariant;
  CatalogCollection : OleVariant;
  CatalogObject : OleVariant;
  i : Integer;
begin
  try
    COMAdminCatalog := CreateOleObject('COMAdmin.COMAdminCatalog');
    CatalogCollection :=
    COMAdminCatalog.GetCollection('Applications');
    CatalogCollection.Populate;
    for i := 0 to CatalogCollection.Count - 1 do
    if AnsiCompareText(CatalogCollection.Item[i].Name, aComAppName) = 0 then Break;
    if i = CatalogCollection.Count then
    begin
    CatalogObject := CatalogCollection.Add;
    CatalogObject.Value['Name'] := aComAppName;
    CatalogCollection.SaveChanges;
    end
    else
    CatalogObject := CatalogCollection.Item[i];
    COMAdminCatalog.InstallComponent(CatalogObject.Name, aDllName, '', '');
    Result := True;
  except
    Result := False;
  end;
end;

//卸载COM+应用程序
class function TSfComTools.UnInstallCOMApplication(const aComAppName: String):Boolean;stdcall;
//const
  //SComApplicationName = '你的应用程序名';
var
  COMAdminCatalog : OleVariant;
  CatalogCollection : OleVariant;
  i : Integer;
begin 
  try
    COMAdminCatalog := CreateOleObject('COMAdmin.COMAdminCatalog');
    CatalogCollection := COMAdminCatalog.GetCollection('Applications');
    CatalogCollection.Populate;
    for i := 0 to CatalogCollection.Count - 1 do
    if AnsiCompareText(CatalogCollection.Item[i].Name, aComAppName) = 0 then
    begin
    CatalogCollection.Remove(i);
    CatalogCollection.SaveChanges;
    Break;
    end;
    Result := True;
  except
    Result := False;
  end;
end;

//启动/关闭COM+服务
class function TSfComTools.StartCOMService(const aComAppName: String; const  AStart : Boolean):Boolean;stdcall;
//const
  //SComApplicationName = '你的应用程序名';
var
  COMAdminCatalog : OleVariant;
  CatalogCollection : OleVariant;
  i : Integer;
begin
  Result := False;
  try
    COMAdminCatalog := CreateOleObject('COMAdmin.COMAdminCatalog');
    CatalogCollection := COMAdminCatalog.GetCollection('Applications');
    CatalogCollection.Populate;
    for i := 0 to CatalogCollection.Count - 1 do
    if AnsiCompareText(CatalogCollection.Item[i].Name, aComAppName) = 0 then
    begin
      if AStart then
        COMAdminCatalog.StartApplication(aComAppName)
      else
        COMAdminCatalog.ShutdownApplication (aComAppName);
      Result := True;
      Break;
    end;
  except
  end;
end;

function StartCOMService(const aComAppName: String; const AStart : Boolean):Boolean;stdcall;
begin
  TSfComTools.StartCOMService(aComAppName, AStart);
end;

 

 

end.