ab override test

gistfile1.txt

' Listupcomport 
#console
#include<RGBALib.sbp>
Const DIGCF_DEFAULT = &H1 ' only valid with DIGCF_DEVICEINTERFACE
Const DIGCF_PRESENT = &H2
Const DIGCF_ALLCLASSES = &H4
Const DIGCF_PROFILE = &H8
Const DIGCF_DEVICEINTERFACE = &H10

Const DICS_ENABLE=1
Const DICS_FLAG_GLOBAL=1
Const DICS_DISABLE=2
Const DICS_FLAG_CONFIGSPECIFIC=2
Const DICS_PROPCHANGE=3
Const DICS_START=4
Const DICS_FLAG_CONFIGGENERAL=4
Const DICS_STOP=5
Const DIREG_DEV	=1
Const DIREG_DRV =2
Const DIREG_BOTH = 4

Const SPDRP_DEVICEDESC = &H0
Const SPDRP_FRIENDLYNAME = &HC

Type SP_DEVINFO_DATA
	cbSize AS DWord
	ClassGuid AS GUID
	DevInst As DWord
	Reserved AS VoidPtr
End Type

Const ProgramName = "test"

' DllLoaderClass("DLL NAME")
'  RegistFunction(func_ptr_ptr, alias)
'  Load(scilent)
'  GetErrorFunction(func_ptr_ptr)
'	protected GetDllHandle()    //継承でこれをオーバーライドしてTST_を置き換える

/* ActiveBasicにおけるオーバーライド
 * 　ActiveBasicでは、クラスの継承による単一メソッドのオーバーライドは可能である。
 *   しかし、スーパークラスにしかないメソッドからオーバーライドしたメソッドを呼び出しても、スーパークラスのメソッドが呼ばれる
 *   使っている側から見ればサブクラスのメソッドを呼んでいるのにもかかわらず
 *  なので関数ポインタを使った手動オーバーライドが必要である。
 *  ただしその場合、自分のクラスのメンバーにアクセスできない。
 */

Class DllLoaderClass
protected
	hDLL AS HANDLE
	DllName AS BytePtr
	
	'関数リスト
	func_list AS *DLL_FUNCTION_CELL
	flist_c AS Long

	'手動オーバーライドする関数
	GetDllHandle As *Function(_DllName As BytePtr) AS HANDLE
	LoadErrMessage As *Sub(opt AS VoidPtr)
	FuncNotFoundMessage As *Sub(dummy AS BytePtr ,alias AS BytePtr,opt AS VoidPtr)

public
	Sub DllLoaderClass(in_dllname AS BytePtr, listlen AS Long)
		DllName=calloc(lstrlen(in_dllname)+1)
		lstrcpy(DllName,in_dllname)

		func_list=calloc(sizeof(DLL_FUNCTION_CELL) * (listlen+1) )
		flist_c=0

		'手動オーバーライド：デフォルトでdef_GetDllHandleをセット。
		'サブクラスが自由に書き換える
		GetDllHandle = AddressOf(def_GetDllHandle)
		LoadErrMessage = AddressOf(def_LoadErrMessage)
		FuncNotFoundMessage = AddressOf(def_FuncNotFoundMessage)
	EndSub

	Sub ~DllLoaderClass()
		free(DllName)			
		DllName=NULL

		free(func_list)
		func_list = NULL

		if hDLL<>NULL Then
			FreeLibrary(hDLL)
			hDLL=NULL
		Endif
	EndSub

	Sub RegistFunc(funcptr AS VoidPtr,alias AS BytePtr)
		func_list[flist_c].ptr=funcptr	:	func_list[flist_c].alias=alias	:	flist_c++
	EndSub
	
	Function LoadDLL(bSilent AS BOOL,opt AS VoidPtr) AS BOOL
		'Initial Return Value is FALSE
		LoadDLL = FALSE

		hDLL=GetDllHandle(DllName)
		if hDLL = NULL Then
			LoadErrMessage(opt)
			ExitFunction
		Endif

		Dim i AS Long
		For i = 0 To flist_c-1
			SetDWord(func_list[i].ptr,GetProcAddress(hDLL,func_list[i].alias))	'Func_List.ptrの先に関数ポインタを格納
			if GetDWord(func_list[i].ptr)=NULL Then
				FuncNotFoundMessage(DllName,func_list[i].alias,opt)
				ExitFunction
			EndIf
		Next i

		LoadDLL = TRUE
	End Function


private
	'ここから先は自分のメンバ変数にアクセスできないので注意
	Function def_GetDllHandle(_DllName As BytePtr) AS HANDLE
		def_GetDllHandle = LoadLibrary(_DllName)
	End Function

	Sub def_LoadErrMessage(opt AS VoidPtr)
		wsprintf(_print_buf,ex"%sのロードに失敗しました。\nDLLが存在するか確認してください。",DllName)
		ErrMes(opt,_print_buf,"DLL Load Error",0,GetLastError())
	End Sub

	Sub def_FuncNotFoundMessage(dllname AS BytePtr, alias AS BytePtr,opt AS VoidPtr)
		wsprintf(_print_buf,ex"%sから必要な関数が見つかりませんでした。\n正しいバージョンのDLLか確認してください。\nProcName : %s",dllname,alias)
		ErrMes(opt,_print_buf,"DLL Load Error",0,GetLastError())
	End Sub

End Class

Class Texst_erad
	Inherits DllLoaderClass
public 
	Sub Texst_erad(in_dllname AS BytePtr, listlen AS Long)
		DllLoaderClass(in_dllname, listlen )

		'手動オーバーライド
		FuncNotFoundMessage=AddressOf(org_FuncNotFoundMessage)
	End Sub

private

	Sub org_FuncNotFoundMessage(dllname AS BytePtr,alias AS BytePtr,opt AS VoidPtr)
		printf(ex"%sから必要な関数が見つかりませんでした。\n正しいバージョンのDLLか確認してください。\nProcName : %s",dllname,alias)
	End Sub
End Class

Class SetupApiWrapper
private 
	dll As *Texst_erad

public
	SetupDiOpenDevRegKey	AS *Function(hDeviceInfoSet AS HANDLE, deviceInfoData AS *SP_DEVINFO_DATA, scope AS DWord, hwProfile AS DWord, KeyType AS BytePtr, samDesired AS DWord) As HANDLE
	SetupDiGetClassDevs		AS *Function(ClassGuid As *GUID, Enumerator As BytePtr, HwndParent As HANDLE, Flags As DWord) As DWord
	SetupDiEnumDeviceInfo	AS *Function(DeviceInfoSet As HANDLE, MemberIndex As Long, DeviceInfoData As *SP_DEVINFO_DATA) As BOOL
	SetupDiClassGuidsFromName AS *Function(ClassName As BytePtr, ClassGuidList As *GUID, ClassGuidListSize As DWord, RequiredSize As Long) As BOOL
	SetupDiGetDeviceRegistryProperty AS *Function(DeviceInfoSet As Long, DeviceInfoData As Long, Property As Long, PropertyRegDataType As Long, PropertyBuffer As BytePtr, PropertyBufferSize As Long, RequiredSize As Long) As BOOL

	Function Load() AS BOOL
		dll=new Texst_erad("setupapi",5)
		'dll->Init("setupapi",5)
		dll->RegistFunc(VarPtr(SetupDiGetClassDevs),   "SetupDiGetClassDevsA5")
		dll->RegistFunc(VarPtr(SetupDiOpenDevRegKey),  "SetupDiOpenDevRegKey")
		dll->RegistFunc(VarPtr(SetupDiEnumDeviceInfo), "SetupDiEnumDeviceInfo")
		dll->RegistFunc(VarPtr(SetupDiClassGuidsFromName), "SetupDiClassGuidsFromNameA")
		dll->RegistFunc(VarPtr(SetupDiGetDeviceRegistryProperty), "SetupDiGetDeviceRegistryPropertyA")
		Load = dll->LoadDLL(FALSE,0 AS VoidPtr)
	End Function

	Sub ~SetupApiWrapper()
		if dll <> NULL Then
			delete dll
			dll=NULL
		Endif
	EndSub
End Class
/*
Declare Function SetupDiOpenDevRegKey Lib "setupapi" Alias "SetupDiOpenDevRegKey" _
	(hDeviceInfoSet AS HANDLE, deviceInfoData AS *SP_DEVINFO_DATA, scope AS DWord, hwProfile AS DWord, KeyType AS BytePtr, samDesired AS DWord) As HANDLE
Declare Function SetupDiGetClassDevs Lib "setupapi.dll" _
	Alias "SetupDiGetClassDevsA" (ClassGuid As *GUID, Enumerator As BytePtr, HwndParent As HANDLE, Flags As DWord) As DWord
Declare Function SetupDiEnumDeviceInfo Lib "setupapi.dll" _
								(DeviceInfoSet As HANDLE, MemberIndex As Long, DeviceInfoData As *SP_DEVINFO_DATA) As BOOL
Declare Function SetupDiClassGuidsFromName Lib "setupapi.dll" _
	Alias "SetupDiClassGuidsFromNameA" (ClassName As BytePtr, ClassGuidList As *GUID, ClassGuidListSize As DWord, RequiredSize As Long) As BOOL
Declare Function SetupDiGetDeviceRegistryProperty Lib "setupapi.dll" _
	Alias "SetupDiGetDeviceRegistryPropertyA" (DeviceInfoSet As Long, DeviceInfoData As Long, Property As Long, PropertyRegDataType As Long, PropertyBuffer As BytePtr, PropertyBufferSize As Long, RequiredSize As Long) As BOOL
*/

TypeDef ESP_CALLBACK_T = *Function(PortName As BytePtr, FriendlyName AS BytePtr) AS Long
Function EnumSerialPorts(sa As *SetupApiWrapper, callback AS ESP_CALLBACK_T) As BOOL

	Dim classGUID[0] As GUID
	Dim DeviceInfoData AS SP_DEVINFO_DATA
	Dim dwReqSize AS DWord
	'個々のコードはWin2000以降専用

	'Setup API の PortsのGUIDを取得 
	DeviceInfoData.cbSize = sizeof(SP_DEVINFO_DATA)
	if sa->SetupDiClassGuidsFromName("Ports", classGUID, 1,VarPtr(dwReqSize)) = FALSE Then
		Print "GetClass Error"
	Endif

	Dim hDevInfoSet AS HANDLE
	hDevInfoSet = sa->SetupDiGetClassDevs(VarPtr(classGUID[0]), NULL, NULL, DIGCF_PRESENT OR DIGCF_PROFILE)

	'printf(ex"%s\n",GuidToTextStr(classGUID))

	'レジストリrエントリを走査
	Dim EnumDeviceIndex AS Long 

	Do
		if sa->SetupDiEnumDeviceInfo(hDevInfoSet, EnumDeviceIndex, VarPtr(DeviceInfoData)) = FALSE Then ExitDo

		Dim regFriendlyName[MAX_PATH] AS Byte
		Dim dwPropType As DWord

		'DevInfoDataから"USB-SERIAL CH340 (COM3)"などのフレンドリーネームを取得
		sa->SetupDiGetDeviceRegistryProperty(
			hDevInfoSet,
			VarPtr(DeviceInfoData),
			SPDRP_DEVICEDESC,
			VarPtr(dwPropType),
			regFriendlyName,
			MAX_PATH,
			VarPtr(dwReqSize)
		)

		' COM3　などのポート名を取得
		Dim hKey AS HANDLE
		hKey = sa->SetupDiOpenDevRegKey(hDevInfoSet,VarPtr(DeviceInfoData),
				                            DICS_FLAG_GLOBAL, 0, DIREG_DEV, KEY_READ)
				
		Dim lpType AS DWord, regReadSize AS DWord
		Dim portName[10] AS Byte
		regReadSize=10
		RegQueryValueEx(hKey,("PortName"),NULL,VarPtr(lpType),portName,VarPtr(regReadSize))
		portName[10]=0

		callback(portName,regFriendlyName)
		EnumDeviceIndex++
	Loop
EndFunction


Main()
Sleep(-1)
Sub Main()
	Dim sa AS SetupApiWrapper
	if sa.Load() = FALSE Then
		Print "Cannot Load setupapi.dll"
		End
	Endif

	EnumSerialPorts(VarPtr(sa), AddressOf(EnumSerialPortsCallback))
EndSub

Sub EnumSerialPortsCallback(PortName As BytePtr, FriendlyName AS BytePtr)
	printf(ex"%s - %s\n",PortName,FriendlyName)
Endsub



Const GUID_TEXT_SIZE = 40
'{3F2504E0-4F89-11D3-9A0C-0305E82C3301}
Function SwapWord(val AS Word) AS Word
	SwapWord = ((val<<8) And &HFF00) Or ((val>>8) And &H00FF) 
End Function

Function ReverseDWord(val As DWord) AS DWord
	'ABCD
	'D  D	; << 3
	' CC	; << 1
	' BB	; >> 1
	'A  A	; >>3
	ReverseDWord = ((val<<24) And &HFF000000) Or ((val<<8) And &H00FF0000)  Or ((val>>8) And &H0000FF00) Or ((val>>24) And &H000000FF) 
EndFunction


Function GuidToText(guid AS *GUID) AS BytePtr
	GuidToText=calloc(GUID_TEXT_SIZE)
	wsprintf(GuidToText, "{%08X-%04X-%04X-%04X-%04X%08X}", _
		guid->Data1,guid->Data2,guid->Data3,SwapWord(GetWord(guid->Data4)), _
		SwapWord(GetWord(guid->Data4+2)),ReverseDWord(GetDWord(guid->Data4+4))
	)
End Function

Function GuidToTextStr(guid AS *GUID) AS String
	Dim guidTextPtr AS BytePtr
	guidTextPtr=GuidToText(guid)
	GuidToTextStr = MakeStr(guidTextPtr)
	free(guidTextPtr) : guidTextPtr=NULL
End Function