Datei folgendes aus den Englischen Forum geladen.
Code: Alles auswählen
;fold
Enumeration
#CLSCTX_INPROC_SERVER = 1
#CLSCTX_INPROC_HANDLER = 2
#CLSCTX_LOCAL_SERVER = 4
#CLSCTX_REMOTE_SERVER = 16
#CLSCTX_SERVER = (#CLSCTX_INPROC_SERVER | #CLSCTX_LOCAL_SERVER | #CLSCTX_REMOTE_SERVER)
EndEnumeration
Structure TYPEATTR
guid.GUID
lcid.l
dwReserved.l
memidConstructor.l
memidDestructor.l
lpstrSchema.l
cbSizeInstance.l
typekind.l
cFuncs.w
cVars.w
cImplTypes.w
cbSizeVft.w
cbAlignment.w
wTypeFlags.w
wMajorVerNum.w
wMinorVerNum.w
tdescAlias.l
idldescType.l
EndStructure
Structure IID ; Interface Identifier structure. a IID is a 16byte value, that uniquely
Data1.l ; identifys each interface.
Data2.w
Data3.w
Data4.w
Data5.b[6]
EndStructure
Global LastMessage.s
Global LastError.l
Procedure.s Uni2Ansi(unicodestr.l) ; Converts Unicode to normal (Ansi) string
lenA = WideCharToMultiByte_(#CP_ACP, 0, unicodestr, -1, 0, 0, 0, 0);
ansistr.s = Space(lenA)
If (lenA > 0)
WideCharToMultiByte_(#CP_ACP, 0, unicodestr, -1, @ansistr, lenA, 0, 0);
EndIf
ProcedureReturn ansistr
EndProcedure
Procedure.l Ansi2Uni(ansistr.s) ; Converts normal (Ansi) string to Unicode
lenA.l = Len(ansistr)
lenW = MultiByteToWideChar_(#CP_ACP, 0, ansistr, lenA, 0, 0)
If (lenW > 0) ; Check whether conversion was successful
unicodestr = SysAllocStringLen_(0, lenW)
MultiByteToWideChar_(#CP_ACP, 0, ansistr, lenA, unicodestr, lenW)
result = unicodestr
ProcedureReturn result
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure.s ShowIID(*iid.IID)
temp.s = RSet(Hex(*iid\Data1), 8, "0") + "-"
temp.s + RSet(Hex(*iid\Data2), 4, "0") + "-"
temp.s + RSet(Hex(*iid\Data3), 4, "0") + "-"
temp.s + RSet(Hex(*iid\Data4), 4, "0") + "-"
For i = 0 To 5
temp.s + RSet(Hex(*iid\Data5[i]), 2, "0")
Next i
ProcedureReturn temp
EndProcedure
Procedure.l CreateObject(ProgID.s) ; Creates COM object from ProgID
err.l = CLSIDFromProgID_(Ansi2Uni(ProgID), @CLSID.GUID)
If err <> #S_OK
LastError = err
LastMessage = "Error CLSID From ProgID. Errorcode: " + Hex(err)
ProcedureReturn 0
EndIf
err.l = CoCreateInstance_(CLSID,0,#CLSCTX_SERVER,?IID_IDispatch,@oDispatch.IDispatch)
If err <> #S_OK
LastError = err
LastMessage = "Error CoCreateInstance. Errorcode: " + Hex(err)
ProcedureReturn 0
EndIf
If oDispatch\GetTypeInfo(0,lcid,@oDispTypeInfo.ITypeInfo) = #S_OK
If oDispTypeInfo\GetTypeAttr(@aTypeAttributes.l) = #S_OK
*oTypeAttributes.TYPEATTR=aTypeAttributes
IID_OBJECT = *oTypeAttributes\guid
oDispTypeInfo\ReleaseTypeAttr(aTypeAttributes)
EndIf
oDispTypeInfo\Release()
EndIf
err.l = oDispatch\QueryInterface(IID_OBJECT,@object.l)
If err <> #S_OK
oDispatch\Release()
LastError = err
LastMessage = "Error QueryInterface. Errorcode: " + Hex(err)
ProcedureReturn 0
EndIf
oDispatch\Release()
ProcedureReturn object
EndProcedure
Procedure ReleaseObject(object.l) ; Releases Object from memory
*object.IUnknown = object
*object\Release()
EndProcedure
Procedure COMLIB_Init()
CoInitialize_(#Null)
EndProcedure
Procedure COMLIB_End()
CoUninitialize_()
EndProcedure
DataSection
IID_IDispatch:
Data.l $00020400
Data.w $0000, $0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
EndDataSection
DataSection
IID_IUnknown:
Data.l $00000000
Data.w $0000, $0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
EndDataSection
;endfold
Code: Alles auswählen
Interface AdUSB Extends IDispatch
Scan(Adr)
GetSerialNr(Adr)
GetDeviceType(Adr)
GetError (Adr)
DigIO (Adr,NewValue)
AnalogIO (Adr,Cha,NewValue)
AnalogVoltage (Adr, Cha, NewValue)
ReadAnalogVoltage(DeviceNr, Channel)
ReadDigIn(DeviceNr)
WriteAnalogVoltage(DeviceNr, Channel, Voltage)
WriteDigOut(DeviceNr, Value)
DataIO(DeviceNr)
Close()
EndInterface
[code]
Aber nach TotalCommander ist dein Interface noch nicht ganz richtig.
Teste mal den Code
COMLIB_Init()
Object.ADUSB = CreateObject("ADUSB2XX.ADUSB2XXCtrl.1")
Debug LastMessage
ReleaseObject(Object)
COMLIB_End()
Konnte nicht Testen, bin nicht Zuhause
FF
:wink: 
