盒子论坛 v2.1

环境：DELPHI7 +WIN7

使用的是导入的COM自动生成的DrugComLib_TLB，出错段在以下代码中，

OUT没有返回值，并报"MSVCR80.DLL"的地址错误，去了首信通过它的测试工具组件是没有问题的，又换工具到2010还是报同样的错误。哪位大神给看看，万分感谢！

procedure TPharmecy.RefundmentDivide_Drugstore(const TradeNo: WideString;
          const Operator: WideString;
          out DivideResult: WideString);
begin
  DefaultInterface.RefundmentDivide_Drugstore(TradeNo, Operator, DivideResult);
end;

此帖子包含附件:

大小:13.0K

----------------------------------------------
-

作者：

arvin (arvin)	★☆☆☆☆	-
	盒子活跃会员

2018/3/4 21:45:17

1楼：

今天又重新装了一下D7，不过这回用的就是医保COM生成的LIB注册成的组件
方法是：通过D7的Import Type library 创建一个LIB单元然后再注册到AxtiveX页
简单试了一下：
procedure TForm1.Button1Click(Sender: TObject);
var aa:string;
bb:string;
out:widestring;
begin
aa:='123456789';
bb:='';
Pharmecy1.Open(out);
showmessage(out);
Pharmecy1.RefundmentDivide_Drugstore(aa,bb,out);
end;

还是这一句报错 MSVCR80.DLL地址错误

这是首信相关组件的下载地址：
http://ybhis.capinfo.com.cn/drugstore/
真的就没有知道的吗？是不是我引用COM的组件方式哪里不对呢？
----------------------------------------------
-

作者：

arvin (arvin)	★☆☆☆☆	-
	盒子活跃会员

2018/3/4 21:45:33

2楼：

unit DrugComLib_TLB;

// ********** //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ********** //

// PASTLWTR : 1.2
// File generated on 2018\3\4 星期日 21:37:18 from Type Library described below.

// **********  //
// Type Lib: C:\Program Files (x86)\Capinfo\BJMediCareDrugStoreClient\1.00.0000\DrugCom.dll (1)
// LIBID: {2FB00DCA-A537-4EE2-929B-0EE2F4FF1C21}
// LCID: 0
// Helpfile :
// HelpString: DrugCom 1.0 类型库
// DepndLst:
//   (1) v2.0 stdole, (C:\Windows\SysWOW64\stdole2.tlb)
// Errors:
//   Error creating palette bitmap of (TPharmecy) : Server C:\Program Files (x86)\Capinfo\BJMediCareDrugStoreClient\1.00.0000\1.00.0042\DrugCom.dll contains no icons
// ********** //
// **********//
// NOTE:
// Items guarded by $IFDEF_LIVE_SERVER_AT_DESIGN_TIME are used by properties
// which return objects that may need to be explicitly created via a function
// call prior to any access via the property. These items have been disabled
// in order to prevent accidental use from within the object inspector. You
// may enable them by defining LIVE_SERVER_AT_DESIGN_TIME or by selectively
// removing them from the $IFDEF blocks. However, such items must still be
// programmatically created via a method of the appropriate CoClass before
// they can be used.
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface

uses Windows, ActiveX, Classes, Graphics, OleServer, StdVCL, Variants;


// **********//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
//   Type Libraries     : LIBID_xxxx
//   CoClasses          : CLASS_xxxx
//   DISPInterfaces     : DIID_xxxx
//   Non-DISP interfaces: IID_xxxx
// **********//
const
  // TypeLibrary Major and minor versions
  DrugComLibMajorVersion = 1;
  DrugComLibMinorVersion = 0;

  LIBID_DrugComLib: TGUID = '{2FB00DCA-A537-4EE2-929B-0EE2F4FF1C21}';

  IID_IPharmecy: TGUID = '{003366C6-D9F6-4A37-B4C0-47524320B479}';
  CLASS_Pharmecy: TGUID = '{454CD8C1-29DA-43AB-AC34-10A51DAD1C66}';
type

// **********//
// Forward declaration of types defined in TypeLibrary
// **********//
  IPharmecy = interface;
  IPharmecyDisp = dispinterface;

// **********//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// **********//
  Pharmecy = IPharmecy;

// **********//
// Interface: IPharmecy
// Flags:     (4544) Dual NonExtensible OleAutomation Dispatchable
// GUID:      {003366C6-D9F6-4A37-B4C0-47524320B479}
// **********//
  IPharmecy = interface(IDispatch)
    ['{003366C6-D9F6-4A37-B4C0-47524320B479}']
    procedure Open(out OutInfo: WideString); safecall;
    procedure Close(out OutInfo: WideString); safecall;
    procedure GetCardInfo(out CardInfo: WideString); safecall;
    procedure InitPB6Env; safecall;
    procedure RefundmentDivide_Drugstore(const TradeNo: WideString; const Operator: WideString;
          out DivideResult: WideString); safecall;
    procedure PrintInvoice_Drugstore(const QueryInfo: WideString; out StateInfo: WideString); safecall;
    procedure GetPersonInfo_Drugstore(const QueryInfo: WideString; out PersonInfo: WideString); safecall;
    procedure Divide_Drugstore(const DivideInfo: WideString; out DivideResult: WideString); safecall;
    procedure Trade_Drugstore(out TradeResult: WideString); safecall;
    procedure CommitTradeState_Drugstore(const TradeNo: WideString; out TradeInfo: WideString); safecall;
    procedure GetExRxInfo(out RxInfoList: WideString); safecall;
    procedure CardInsertState(out iResult: SYSINT; out ErrMsg: WideString); safecall;
    procedure GetDevIdAfterOpen(out lDevId: Integer; out ErrMsg: WideString); safecall;
    procedure GetDrugStoreID(out DrugStoreID: WideString; out ErrMsg: WideString); safecall;
  end;

// **********//
// DispIntf:  IPharmecyDisp
// Flags:     (4544) Dual NonExtensible OleAutomation Dispatchable
// GUID:      {003366C6-D9F6-4A37-B4C0-47524320B479}
// **********//
  IPharmecyDisp = dispinterface
    ['{003366C6-D9F6-4A37-B4C0-47524320B479}']
    procedure Open(out OutInfo: WideString); dispid 1;
    procedure Close(out OutInfo: WideString); dispid 2;
    procedure GetCardInfo(out CardInfo: WideString); dispid 3;
    procedure InitPB6Env; dispid 4;
    procedure RefundmentDivide_Drugstore(const TradeNo: WideString; const Operator: WideString;
          out DivideResult: WideString); dispid 5;
    procedure PrintInvoice_Drugstore(const QueryInfo: WideString; out StateInfo: WideString); dispid 6;
    procedure GetPersonInfo_Drugstore(const QueryInfo: WideString; out PersonInfo: WideString); dispid 7;
    procedure Divide_Drugstore(const DivideInfo: WideString; out DivideResult: WideString); dispid 8;
    procedure Trade_Drugstore(out TradeResult: WideString); dispid 9;
    procedure CommitTradeState_Drugstore(const TradeNo: WideString; out TradeInfo: WideString); dispid 10;
    procedure GetExRxInfo(out RxInfoList: WideString); dispid 11;
    procedure CardInsertState(out iResult: SYSINT; out ErrMsg: WideString); dispid 12;
    procedure GetDevIdAfterOpen(out lDevId: Integer; out ErrMsg: WideString); dispid 13;
    procedure GetDrugStoreID(out DrugStoreID: WideString; out ErrMsg: WideString); dispid 14;
  end;

// **********//
// The Class CoPharmecy provides a Create and CreateRemote method to
// create instances of the default interface IPharmecy exposed by
// the CoClass Pharmecy. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// **********//
  CoPharmecy = class
    class function Create: IPharmecy;
    class function CreateRemote(const MachineName: string): IPharmecy;
  end;

// **********//
// OLE Server Proxy class declaration
// Server Object    : TPharmecy
// Help String      : Pharmecy Class
// Default Interface: IPharmecy
// Def. Intf. DISP? : No
// Event   Interface:
// TypeFlags        : (2) CanCreate
// **********//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  TPharmecyProperties= class;
{$ENDIF}
  TPharmecy = class(TOleServer)
  private
    FIntf:        IPharmecy;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
    FProps:       TPharmecyProperties;
    function      GetServerProperties: TPharmecyProperties;
{$ENDIF}
    function      GetDefaultInterface: IPharmecy;
  protected
    procedure InitServerData; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure Connect; override;
    procedure ConnectTo(svrIntf: IPharmecy);
    procedure Disconnect; override;
    procedure Open(out OutInfo: WideString);
    procedure Close(out OutInfo: WideString);
    procedure GetCardInfo(out CardInfo: WideString);
    procedure InitPB6Env;
    procedure RefundmentDivide_Drugstore(const TradeNo: WideString; const Operator: WideString;
          out DivideResult: WideString);
    procedure PrintInvoice_Drugstore(const QueryInfo: WideString; out StateInfo: WideString);
    procedure GetPersonInfo_Drugstore(const QueryInfo: WideString; out PersonInfo: WideString);
    procedure Divide_Drugstore(const DivideInfo: WideString; out DivideResult: WideString);
    procedure Trade_Drugstore(out TradeResult: WideString);
    procedure CommitTradeState_Drugstore(const TradeNo: WideString; out TradeInfo: WideString);
    procedure GetExRxInfo(out RxInfoList: WideString);
    procedure CardInsertState(out iResult: SYSINT; out ErrMsg: WideString);
    procedure GetDevIdAfterOpen(out lDevId: Integer; out ErrMsg: WideString);
    procedure GetDrugStoreID(out DrugStoreID: WideString; out ErrMsg: WideString);
    property DefaultInterface: IPharmecy read GetDefaultInterface;
  published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
    property Server: TPharmecyProperties read GetServerProperties;
{$ENDIF}
  end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// **********//
// OLE Server Properties Proxy Class
// Server Object    : TPharmecy
// (This object is used by the IDE's Property Inspector to allow editing
//  of the properties of this server)
// **********//
TPharmecyProperties = class(TPersistent)
  private
    FServer:    TPharmecy;
    function    GetDefaultInterface: IPharmecy;
    constructor Create(AServer: TPharmecy);
  protected
  public
    property DefaultInterface: IPharmecy read GetDefaultInterface;
  published
  end;
{$ENDIF}

procedure Register;

resourcestring
  dtlServerPage = 'ActiveX';

  dtlOcxPage = 'ActiveX';

implementation

uses ComObj;

class function CoPharmecy.Create: IPharmecy;
begin
  Result := CreateComObject(CLASS_Pharmecy) as IPharmecy;
end;

class function CoPharmecy.CreateRemote(const MachineName: string): IPharmecy;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_Pharmecy) as IPharmecy;
end;

procedure TPharmecy.InitServerData;
const
  CServerData: TServerData = (
    ClassID:   '{454CD8C1-29DA-43AB-AC34-10A51DAD1C66}';
    IntfIID:   '{003366C6-D9F6-4A37-B4C0-47524320B479}';
    EventIID:  '';
    LicenseKey: nil;
    Version: 500);
begin
  ServerData := @CServerData;
end;

procedure TPharmecy.Connect;
var
  punk: IUnknown;
begin
  if FIntf = nil then
  begin
    punk := GetServer;
    Fintf:= punk as IPharmecy;
  end;
end;

procedure TPharmecy.ConnectTo(svrIntf: IPharmecy);
begin
  Disconnect;
  FIntf := svrIntf;
end;

procedure TPharmecy.DisConnect;
begin
  if Fintf <> nil then
  begin
    FIntf := nil;
  end;
end;

function TPharmecy.GetDefaultInterface: IPharmecy;
begin
  if FIntf = nil then
    Connect;
  Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
  Result := FIntf;
end;

constructor TPharmecy.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps := TPharmecyProperties.Create(Self);
{$ENDIF}
end;

destructor TPharmecy.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps.Free;
{$ENDIF}
  inherited Destroy;
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TPharmecy.GetServerProperties: TPharmecyProperties;
begin
  Result := FProps;
end;
{$ENDIF}

procedure TPharmecy.Open(out OutInfo: WideString);
begin
  DefaultInterface.Open(OutInfo);
end;

procedure TPharmecy.Close(out OutInfo: WideString);
begin
  DefaultInterface.Close(OutInfo);
end;

procedure TPharmecy.GetCardInfo(out CardInfo: WideString);
begin
  DefaultInterface.GetCardInfo(CardInfo);
end;

procedure TPharmecy.InitPB6Env;
begin
  DefaultInterface.InitPB6Env;
end;

procedure TPharmecy.RefundmentDivide_Drugstore(const TradeNo: WideString;
          const Operator: WideString;
          out DivideResult: WideString);
begin
  DefaultInterface.RefundmentDivide_Drugstore(TradeNo, Operator, DivideResult);
end;

procedure TPharmecy.PrintInvoice_Drugstore(const QueryInfo: WideString; out StateInfo: WideString);
begin
  DefaultInterface.PrintInvoice_Drugstore(QueryInfo, StateInfo);
end;

procedure TPharmecy.GetPersonInfo_Drugstore(const QueryInfo: WideString; out PersonInfo: WideString);
begin
  DefaultInterface.GetPersonInfo_Drugstore(QueryInfo, PersonInfo);
end;

procedure TPharmecy.Divide_Drugstore(const DivideInfo: WideString; out DivideResult: WideString);
begin
  DefaultInterface.Divide_Drugstore(DivideInfo, DivideResult);
end;

procedure TPharmecy.Trade_Drugstore(out TradeResult: WideString);
begin
  DefaultInterface.Trade_Drugstore(TradeResult);
end;

procedure TPharmecy.CommitTradeState_Drugstore(const TradeNo: WideString; out TradeInfo: WideString);
begin
  DefaultInterface.CommitTradeState_Drugstore(TradeNo, TradeInfo);
end;

procedure TPharmecy.GetExRxInfo(out RxInfoList: WideString);
begin
  DefaultInterface.GetExRxInfo(RxInfoList);
end;

procedure TPharmecy.CardInsertState(out iResult: SYSINT; out ErrMsg: WideString);
begin
  DefaultInterface.CardInsertState(iResult, ErrMsg);
end;

procedure TPharmecy.GetDevIdAfterOpen(out lDevId: Integer; out ErrMsg: WideString);
begin
  DefaultInterface.GetDevIdAfterOpen(lDevId, ErrMsg);
end;

procedure TPharmecy.GetDrugStoreID(out DrugStoreID: WideString; out ErrMsg: WideString);
begin
  DefaultInterface.GetDrugStoreID(DrugStoreID, ErrMsg);
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TPharmecyProperties.Create(AServer: TPharmecy);
begin
  inherited Create;
  FServer := AServer;
end;

function TPharmecyProperties.GetDefaultInterface: IPharmecy;
begin
  Result := FServer.DefaultInterface;
end;

{$ENDIF}

procedure Register;
begin
  RegisterComponents(dtlServerPage, [TPharmecy]);
end;

end.
----------------------------------------------
-

作者：

arvin (arvin)	★☆☆☆☆	-
	盒子活跃会员

2018/3/5 2:16:45

3楼：

路过的帮我顶一下吧？
----------------------------------------------
-

作者：

zhangpuqing (pupu)	★☆☆☆☆	-
	普通会员

2018/3/5 10:19:26

4楼：

顶!
----------------------------------------------
-

作者：

arvin (arvin)	★☆☆☆☆	-
	盒子活跃会员

2018/3/5 11:30:26

5楼：

楼上，好兄弟！

我又测试了一下首信的另一个医院端的COM组件，这个可以，能成功返回值，也不会报错。你懂的，面对大公司我总是心虚.

此帖子包含附件:

大小:9.8K

----------------------------------------------
-

作者：

arvin (arvin)	★☆☆☆☆	-
	盒子活跃会员

2018/3/5 11:32:22

6楼：

同一家公司的，一个组件是面对医院的，退费分解函数就正常，而面对药店的报错.
不会是DELPHI生成的LIB文件有问题吧？附医院组件的LIB文件
----------------------------------------------
-

作者：

arvin (arvin)	★☆☆☆☆	-
	盒子活跃会员

2018/3/5 11:35:14

7楼：

unit MedicareComLib_TLB;

// ********** //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ********** //

// PASTLWTR : 1.2
// File generated on 2018\3\5 星期一 2:34:08 from Type Library described below.

// **********  //
// Type Lib: C:\Program Files (x86)\Capinfo\BeiJingMediCareClient\1.00.0000\MedicareCom.dll (1)
// LIBID: {232E9616-F847-49F7-9AC3-095831429411}
// LCID: 0
// Helpfile :
// HelpString: MedicareCom 1.0 类型库
// DepndLst:
//   (1) v2.0 stdole, (C:\Windows\SysWOW64\stdole2.tlb)
// Errors:
//   Error creating palette bitmap of (TOutpatient) : Server C:\Program Files (x86)\Capinfo\BeiJingMediCareClient\1.00.0000\MedicareCom.dll contains no icons
// ********** //
// **********//
// NOTE:
// Items guarded by $IFDEF_LIVE_SERVER_AT_DESIGN_TIME are used by properties
// which return objects that may need to be explicitly created via a function
// call prior to any access via the property. These items have been disabled
// in order to prevent accidental use from within the object inspector. You
// may enable them by defining LIVE_SERVER_AT_DESIGN_TIME or by selectively
// removing them from the $IFDEF blocks. However, such items must still be
// programmatically created via a method of the appropriate CoClass before
// they can be used.
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface

uses Windows, ActiveX, Classes, Graphics, OleServer, StdVCL, Variants;


// **********//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
//   Type Libraries     : LIBID_xxxx
//   CoClasses          : CLASS_xxxx
//   DISPInterfaces     : DIID_xxxx
//   Non-DISP interfaces: IID_xxxx
// **********//
const
  // TypeLibrary Major and minor versions
  MedicareComLibMajorVersion = 1;
  MedicareComLibMinorVersion = 0;

  LIBID_MedicareComLib: TGUID = '{232E9616-F847-49F7-9AC3-095831429411}';

  IID_IOutpatient: TGUID = '{D1ED1DEE-8994-431C-B048-C0586E4A4C31}';
  CLASS_Outpatient: TGUID = '{6ED3D8A4-FD47-4ED8-A93F-96EB87B5D830}';
type

// **********//
// Forward declaration of types defined in TypeLibrary
// **********//
  IOutpatient = interface;
  IOutpatientDisp = dispinterface;

// **********//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// **********//
  Outpatient = IOutpatient;

// **********//
// Declaration of structures, unions and aliases.
// **********//
  PWideString1 = ^WideString; {*}

// **********//
// Interface: IOutpatient
// Flags:     (4544) Dual NonExtensible OleAutomation Dispatchable
// GUID:      {D1ED1DEE-8994-431C-B048-C0586E4A4C31}
// **********//
  IOutpatient = interface(IDispatch)
    ['{D1ED1DEE-8994-431C-B048-C0586E4A4C31}']
    procedure Open(out OutInfo: WideString); safecall;
    procedure Close(out OutInfo: WideString); safecall;
    procedure GetPersonInfo(out PersonInfo: WideString); safecall;
    procedure Divide(const DivideInfo: WideString; out DivideResult: WideString); safecall;
    procedure Trade(out TradeResult: WideString); safecall;
    procedure RePrintInvoice(const TradeNo: WideString; const InvoiceNo: WideString;
          out StateInfo: WideString); safecall;
    procedure RefundmentDivide(const TradeNo: WideString; const Operator: WideString;
          out DivideResult: WideString); safecall;
    procedure GetCardInfo(out CardInfo: WideString); safecall;
    procedure MedicareQuery(const QueryIn: WideString; out QueryOut: WideString); safecall;
    procedure InitPB6Env; safecall;
    procedure CapinfoTest(const TestInfo: WideString; var TestResult: WideString); safecall;
    procedure CommitTradeState(const TradeNo: WideString; out TradeInfo: WideString); safecall;
    procedure TransferTreatment(const HospCode: WideString; TransferDate: TDateTime); safecall;
    procedure CardInsertState(out iResult: SYSINT; out ErrMsg: WideString); safecall;
    procedure GetDevIdAfterOpen(out lDevId: Integer; out ErrMsg: WideString); safecall;
  end;

// **********//
// DispIntf:  IOutpatientDisp
// Flags:     (4544) Dual NonExtensible OleAutomation Dispatchable
// GUID:      {D1ED1DEE-8994-431C-B048-C0586E4A4C31}
// **********//
  IOutpatientDisp = dispinterface
    ['{D1ED1DEE-8994-431C-B048-C0586E4A4C31}']
    procedure Open(out OutInfo: WideString); dispid 1;
    procedure Close(out OutInfo: WideString); dispid 2;
    procedure GetPersonInfo(out PersonInfo: WideString); dispid 3;
    procedure Divide(const DivideInfo: WideString; out DivideResult: WideString); dispid 4;
    procedure Trade(out TradeResult: WideString); dispid 5;
    procedure RePrintInvoice(const TradeNo: WideString; const InvoiceNo: WideString;
          out StateInfo: WideString); dispid 6;
    procedure RefundmentDivide(const TradeNo: WideString; const Operator: WideString;
          out DivideResult: WideString); dispid 7;
    procedure GetCardInfo(out CardInfo: WideString); dispid 8;
    procedure MedicareQuery(const QueryIn: WideString; out QueryOut: WideString); dispid 9;
    procedure InitPB6Env; dispid 10;
    procedure CapinfoTest(const TestInfo: WideString; var TestResult: WideString); dispid 11;
    procedure CommitTradeState(const TradeNo: WideString; out TradeInfo: WideString); dispid 12;
    procedure TransferTreatment(const HospCode: WideString; TransferDate: TDateTime); dispid 13;
    procedure CardInsertState(out iResult: SYSINT; out ErrMsg: WideString); dispid 14;
    procedure GetDevIdAfterOpen(out lDevId: Integer; out ErrMsg: WideString); dispid 15;
  end;

// **********//
// The Class CoOutpatient provides a Create and CreateRemote method to
// create instances of the default interface IOutpatient exposed by
// the CoClass Outpatient. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// **********//
  CoOutpatient = class
    class function Create: IOutpatient;
    class function CreateRemote(const MachineName: string): IOutpatient;
  end;

// **********//
// OLE Server Proxy class declaration
// Server Object    : TOutpatient
// Help String      : Outpatient Class
// Default Interface: IOutpatient
// Def. Intf. DISP? : No
// Event   Interface:
// TypeFlags        : (2) CanCreate
// **********//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  TOutpatientProperties= class;
{$ENDIF}
  TOutpatient = class(TOleServer)
  private
    FIntf:        IOutpatient;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
    FProps:       TOutpatientProperties;
    function      GetServerProperties: TOutpatientProperties;
{$ENDIF}
    function      GetDefaultInterface: IOutpatient;
  protected
    procedure InitServerData; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure Connect; override;
    procedure ConnectTo(svrIntf: IOutpatient);
    procedure Disconnect; override;
    procedure Open(out OutInfo: WideString);
    procedure Close(out OutInfo: WideString);
    procedure GetPersonInfo(out PersonInfo: WideString);
    procedure Divide(const DivideInfo: WideString; out DivideResult: WideString);
    procedure Trade(out TradeResult: WideString);
    procedure RePrintInvoice(const TradeNo: WideString; const InvoiceNo: WideString;
          out StateInfo: WideString);
    procedure RefundmentDivide(const TradeNo: WideString; const Operator: WideString;
          out DivideResult: WideString);
    procedure GetCardInfo(out CardInfo: WideString);
    procedure MedicareQuery(const QueryIn: WideString; out QueryOut: WideString);
    procedure InitPB6Env;
    procedure CapinfoTest(const TestInfo: WideString; var TestResult: WideString);
    procedure CommitTradeState(const TradeNo: WideString; out TradeInfo: WideString);
    procedure TransferTreatment(const HospCode: WideString; TransferDate: TDateTime);
    procedure CardInsertState(out iResult: SYSINT; out ErrMsg: WideString);
    procedure GetDevIdAfterOpen(out lDevId: Integer; out ErrMsg: WideString);
    property DefaultInterface: IOutpatient read GetDefaultInterface;
  published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
    property Server: TOutpatientProperties read GetServerProperties;
{$ENDIF}
  end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// **********//
// OLE Server Properties Proxy Class
// Server Object    : TOutpatient
// (This object is used by the IDE's Property Inspector to allow editing
//  of the properties of this server)
// **********//
TOutpatientProperties = class(TPersistent)
  private
    FServer:    TOutpatient;
    function    GetDefaultInterface: IOutpatient;
    constructor Create(AServer: TOutpatient);
  protected
  public
    property DefaultInterface: IOutpatient read GetDefaultInterface;
  published
  end;
{$ENDIF}

procedure Register;

resourcestring
  dtlServerPage = 'ActiveX';

  dtlOcxPage = 'ActiveX';

implementation

uses ComObj;

class function CoOutpatient.Create: IOutpatient;
begin
  Result := CreateComObject(CLASS_Outpatient) as IOutpatient;
end;

class function CoOutpatient.CreateRemote(const MachineName: string): IOutpatient;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_Outpatient) as IOutpatient;
end;

procedure TOutpatient.InitServerData;
const
  CServerData: TServerData = (
    ClassID:   '{6ED3D8A4-FD47-4ED8-A93F-96EB87B5D830}';
    IntfIID:   '{D1ED1DEE-8994-431C-B048-C0586E4A4C31}';
    EventIID:  '';
    LicenseKey: nil;
    Version: 500);
begin
  ServerData := @CServerData;
end;

procedure TOutpatient.Connect;
var
  punk: IUnknown;
begin
  if FIntf = nil then
  begin
    punk := GetServer;
    Fintf:= punk as IOutpatient;
  end;
end;

procedure TOutpatient.ConnectTo(svrIntf: IOutpatient);
begin
  Disconnect;
  FIntf := svrIntf;
end;

procedure TOutpatient.DisConnect;
begin
  if Fintf <> nil then
  begin
    FIntf := nil;
  end;
end;

function TOutpatient.GetDefaultInterface: IOutpatient;
begin
  if FIntf = nil then
    Connect;
  Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
  Result := FIntf;
end;

constructor TOutpatient.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps := TOutpatientProperties.Create(Self);
{$ENDIF}
end;

destructor TOutpatient.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps.Free;
{$ENDIF}
  inherited Destroy;
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TOutpatient.GetServerProperties: TOutpatientProperties;
begin
  Result := FProps;
end;
{$ENDIF}

procedure TOutpatient.Open(out OutInfo: WideString);
begin
  DefaultInterface.Open(OutInfo);
end;

procedure TOutpatient.Close(out OutInfo: WideString);
begin
  DefaultInterface.Close(OutInfo);
end;

procedure TOutpatient.GetPersonInfo(out PersonInfo: WideString);
begin
  DefaultInterface.GetPersonInfo(PersonInfo);
end;

procedure TOutpatient.Divide(const DivideInfo: WideString; out DivideResult: WideString);
begin
  DefaultInterface.Divide(DivideInfo, DivideResult);
end;

procedure TOutpatient.Trade(out TradeResult: WideString);
begin
  DefaultInterface.Trade(TradeResult);
end;

procedure TOutpatient.RePrintInvoice(const TradeNo: WideString; const InvoiceNo: WideString;
          out StateInfo: WideString);
begin
  DefaultInterface.RePrintInvoice(TradeNo, InvoiceNo, StateInfo);
end;

procedure TOutpatient.RefundmentDivide(const TradeNo: WideString; const Operator: WideString;
          out DivideResult: WideString);
begin
  DefaultInterface.RefundmentDivide(TradeNo, Operator, DivideResult);
end;

procedure TOutpatient.GetCardInfo(out CardInfo: WideString);
begin
  DefaultInterface.GetCardInfo(CardInfo);
end;

procedure TOutpatient.MedicareQuery(const QueryIn: WideString; out QueryOut: WideString);
begin
  DefaultInterface.MedicareQuery(QueryIn, QueryOut);
end;

procedure TOutpatient.InitPB6Env;
begin
  DefaultInterface.InitPB6Env;
end;

procedure TOutpatient.CapinfoTest(const TestInfo: WideString; var TestResult: WideString);
begin
  DefaultInterface.CapinfoTest(TestInfo, TestResult);
end;

procedure TOutpatient.CommitTradeState(const TradeNo: WideString; out TradeInfo: WideString);
begin
  DefaultInterface.CommitTradeState(TradeNo, TradeInfo);
end;

procedure TOutpatient.TransferTreatment(const HospCode: WideString; TransferDate: TDateTime);
begin
  DefaultInterface.TransferTreatment(HospCode, TransferDate);
end;

procedure TOutpatient.CardInsertState(out iResult: SYSINT; out ErrMsg: WideString);
begin
  DefaultInterface.CardInsertState(iResult, ErrMsg);
end;

procedure TOutpatient.GetDevIdAfterOpen(out lDevId: Integer; out ErrMsg: WideString);
begin
  DefaultInterface.GetDevIdAfterOpen(lDevId, ErrMsg);
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TOutpatientProperties.Create(AServer: TOutpatient);
begin
  inherited Create;
  FServer := AServer;
end;

function TOutpatientProperties.GetDefaultInterface: IOutpatient;
begin
  Result := FServer.DefaultInterface;
end;

{$ENDIF}

procedure Register;
begin
  RegisterComponents(dtlServerPage, [TOutpatient]);
end;

end.
----------------------------------------------
-

作者：

arvin (arvin)	★☆☆☆☆	-
	盒子活跃会员

2018/3/5 11:36:42

8楼：

//出问题的就是药店组件的退费分解函数
var
  frmpharmecy: Tfrmpharmecy;
   Pharmecy:TPharmecy;
implementation

{$R *.dfm}

procedure Tfrmpharmecy.Button1Click(Sender: TObject);
var aa,bb,cc:widestring;
begin
  Pharmecy:=TPharmecy.Create(self);
  Pharmecy.RefundmentDivide_Drugstore(aa,bb,cc);   //tradno,operator,divderesult
  memo1.Lines.Add(aa);
  memo1.Lines.Add(bb);
  memo1.Lines.Add(cc);
  Pharmecy.Free;
  Pharmecy:=nil;
end;
----------------------------------------------
-

作者：

luwakin (luwakin)	★☆☆☆☆	-
	普通会员

2018/3/5 11:44:44

9楼：

MSVCR80.DLL 是Microsoft Visual C++ Runtime 的的一个dll吧，你安装下这个c++库试试看
----------------------------------------------
-

作者：

arvin (arvin)	★☆☆☆☆	-
	盒子活跃会员

2018/3/5 12:12:15

10楼：

试过了， MSVCR80.DLL是有这个动态库的，据说是VC开发的程序需要用到。而且我之前已经下载了这个动态库，重新注册。还是不行。
首信有两个医保发布的两个COM组件，一个是面对医院的，一个是药店的。测试了医院的没有问题。只有这个药店的COM组件报这个错误。.而且该药店组件的其它函数都没有问题。只有这个退费分解RefundmentDivide_Drugstore的函数报此错误。
----------------------------------------------
-

作者：

arvin (arvin)	★☆☆☆☆	-
	盒子活跃会员

2018/3/5 12:29:37

11楼：

安装了C++库，MSVBCRT_AIO_2018.01.15_X86
还是不行，有谁能帮忙用自己的环境测一下吗？是不是也同样报错呢？我有写好的简单DEMO，只需要下载一下核心组件端
http://ybhis.capinfo.com.cn/这是医院的核心组件端下载页
http://ybhis.capinfo.com.cn/drugstore/ 这是药店组件端的下载页

万分感谢

此帖子包含附件:arvin_201835122936.rar 大小:383.1K

----------------------------------------------
-

作者：

wang_80919 (Flying Wang)	★☆☆☆☆	-
	普通会员

2018/3/5 12:35:17

12楼：

一群白痴。
人家提示很明显。
AV 错误。
真正的彻底的解决办法。
谁有 COM 的源码，谁才能解决。
将你的测试环境，例如你的调用 EXE 发给 COM 开发者。
叫这个 COM 开发者找出他自己的错误。
如果他说是你传入参数的错误，那你再改。
否则，就是他自己的内部错误。

理论上，就这几个参数，应该不是传入参数的问题吧。

另外，楼主测试的代码，要保证没有用多线程，因为 COM 的多线程，需要初始化。

如果对方不配合。
你又想证明是 DELPHI 的问题。
办法很简单，你用 VBA 去调用。
如果 VBA 没问题，再说。
----------------------------------------------
(C)(P)Flying Wang

作者：

arvin (arvin)	★☆☆☆☆	-
	盒子活跃会员

2018/3/5 12:54:13

13楼：

回复Flying Wang，非常感谢！
我在今天稍早前已经将问题发给对方公司。
VB不会用啊
另外我了解到有人用VS开发的程序是可以调用的。
----------------------------------------------
-

作者：

wang_80919 (Flying Wang)	★☆☆☆☆	-
	普通会员

2018/3/5 13:00:23

14楼：

VBA 都不会，搞什么开发？
打开一个 WORD 或者 EXCL ，打开里头的开发工具，然后就能调用 COM 了。
----------------------------------------------
(C)(P)Flying Wang

作者：

looper (keyo)	★☆☆☆☆	-
	盒子活跃会员

2018/3/5 13:54:04

15楼：

你用其他开发工具简单调看看这个COM出错的方法，看看别的开发工具是怎么传参数的。
一般就是字符串widestring或者string的问题。。。
----------------------------------------------
虽千万人吾往矣！

作者：

nevergrief (孤独骑士)	★☆☆☆☆	-
	盒子活跃会员

2018/3/5 18:52:00

16楼：

我觉得就是你的 out :widestring的问题。要在delphi里提前分配空间，然后传递指针。
----------------------------------------------
只有偏执狂才能生存！

作者：

arvin (arvin)	★☆☆☆☆	-
	盒子活跃会员

2018/3/5 19:27:36

17楼：

com生成的lib类我改不了，人家也不可能让我改,VB学过早忘了，我今年都得50了。我觉得wang_80919 (Flying Wang)说的靠谱点。我可以试试这个用EXCEL调用COM的办法试试。
----------------------------------------------
-

作者：

bahamut8348 (leonna)	★☆☆☆☆	-
	普通会员

2018/3/5 23:49:32

18楼：

看看对方提供的例子，一般医保公司的开发人员的代码都很糙的。很多时候char*和bstr会乱用。
而在导入com的时候，delphi会把char*和bstr统一翻译成widestring。
这个问题要注意。

另外，约定也是个问题。我没记错delphi在导入alt的时候统一会用safecall，而一些操蛋的开发者会stdcall,cdecl以及safecall乱用。这里也要注意。
----------------------------------------------
--

作者：

looper (keyo)	★☆☆☆☆	-
	盒子活跃会员

2018/3/6 9:06:21

19楼：

procedure TForm1.Button1Click(Sender: TObject);
var aa:string;
bb:string;
out:pwidechar; //这里widestring改成pwidechar
begin
aa:='123456789';
bb:='';
Pharmecy1.Open(out);
showmessage(out);
Pharmecy1.RefundmentDivide_Drugstore(aa,bb,out);
end;

你这样看看还会不会报错。
----------------------------------------------
虽千万人吾往矣！

作者：

looper (keyo)	★☆☆☆☆	-
	盒子活跃会员

2018/3/6 9:09:21

20楼：

或者你把dll传上来，让大家帮你调试看看
----------------------------------------------
虽千万人吾往矣！

作者：

arvin (arvin)	★☆☆☆☆	-
	盒子活跃会员

2018/3/6 11:08:20

21楼：

回楼上，不行的.COM组件是首信发布好的，生成的函数也是自动生成的，根本改不了。
入口参数类型也是规定好的。Pharmecy1.RefundmentDivide_Drugstore(aa,bb,out);
这里的OUT要求使用的是WideString因为这是输出参数，返回的是XML内容.您要能帮我测更好，DLL，是安装的，我已经在上面留了下载的网址。上面也有COM接口文档.
关于这个的函数说明是这样的：
4.2.5  退费分解
函数名称：RefundmentDivide_Drugstore
参数：
输入参数：
BSTR TradeNo:交易流水号   字符串
BSTR Operator：收费员      字符串
状态返回值：HRESULT成功执行返回0，否则返回非零值
您要是有时间帮我测一下最好。最担心的是本人水平太LOW
这是我的QQ号：501317053，加入时请注明，盒子论坛!
不管怎么说盒子是我家，不管能不能解决问题，大家的热心我心领了！
----------------------------------------------
-

作者：

vkow (vkow)	★☆☆☆☆	-
	普通会员

2018/3/6 18:11:00

22楼：

这么热闹。明白人不多啊。

不是有人都告诉你了么？

拿VB脚本测试一下才是关键。VB如果调用没问题，再说。

说什么widestring，safecall的，都是扯淡。你把COM当dll了么？

另外，楼主啊。做项目，交流比闷头干重要。
如果你不懂VB，可以打电话问问com的开发人员，跟人家说明情况，帮你写个测试VB脚本。多简单的事情。

还有啊，如果不算参数初始化的代码，vb脚本不会超过3行。人家十来分钟就能搞定的事情。

还有说什么把dll传上来的。给了dll你没环境能看明白什么？
----------------------------------------------
-

作者：

looper (keyo)	★☆☆☆☆	-
	盒子活跃会员

2018/3/6 18:15:25

23楼：

@vkow (vkow)：你真逗！
----------------------------------------------
虽千万人吾往矣！

作者：

wang_80919 (Flying Wang)	★☆☆☆☆	-
	普通会员

2018/3/6 18:25:20

24楼：

23 楼更逗。
COM 的类型就那么几种。
格式都是 tlb 规定的。参数类型 call类型，都是自动取得的。不是你想改就能改的。
TLB 是根据 COM 编译结果生成的。除非生成代码的 BUG，否则不需要修改。

看 18 楼的意思。
大概是 COM 开发人员可能实现的参数类型 call类型和他们设计的类型不一致。

这种情况，更得要 COM 开发人员来出面了。
他们必须说清楚，他们实现 COM 的时候，参数和 cll 是怎么定义的。
----------------------------------------------
(C)(P)Flying Wang

作者：

vkow (vkow)	★☆☆☆☆	-
	普通会员

2018/3/6 19:01:26

25楼：

@looper (keyo)
@wang_80919 (Flying Wang)

别吵了。我错了。
我知道问题出在哪里了。
晚上我有时间了，给楼主明确回复一下。

具体问题是出在DELPHI 7身上了。

我前面说的话，一半正确一半错误。理论正确，实际是错误的。
我只是看到了COM，没太注意是DELPHI7。如果是DELPHI7的话，那问题十有八九是楼主的代码问题。
----------------------------------------------
-

作者：

looper (keyo)	★☆☆☆☆	-
	盒子活跃会员

2018/3/6 20:43:47

26楼：

确实是楼主代码有些问题，不过跟d7没关系，其实我下午下载了他的dll，已经帮他解决掉了。

com的问题，没有环境确实没办法调试，但是他是报内存错误，那下载dll下来，帮他把内存错误解决就好了，所以下载dll还是有用的。
----------------------------------------------
虽千万人吾往矣！

作者：

arvin (arvin)	★☆☆☆☆	-
	盒子活跃会员

2018/3/6 20:51:56

27楼：

我来是结贴的，确实是自己的问题。我留了QQ号，但最终还是不清楚具体是盒子的哪位朋友帮了我。只知道他的QQ昵称叫“花太香”在这里特别感谢这位朋友，也同时感谢其他热心的朋友。至于问题只怪自己基础不扎实。
----------------------------------------------
-

作者：

wang_80919 (Flying Wang)	★☆☆☆☆	-
	普通会员

2018/3/7 8:36:57

28楼：

然后大家都是保密局的。
怎么出的问题，闭口不谈。
----------------------------------------------
(C)(P)Flying Wang

作者：

arvin (arvin)	★☆☆☆☆	-
	盒子活跃会员

2018/3/7 20:04:49

29楼：

不是啊，说出来太丢人，我就引用接口的LIB错了，没有找对类，所以在创建和使用的时候会报这个错误。
----------------------------------------------
-

信息

登陆以后才能回复