listup serialport

conlistup

' 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_を置き換える
Class DllLoaderClass
protected
	hDLL AS HANDLE
	DllName AS BytePtr
	
	func_list AS *DLL_FUNCTION_CELL
	flist_c AS Long
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
	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(func_list[i].alias,opt)
				ExitFunction
			EndIf
		Next i

		LoadDLL = TRUE
	End Function

protected
	Function GetDllHandle(_DllName As BytePtr) AS HANDLE
		GetDllHandle = LoadLibrary(_DllName)
	End Function

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

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

End Class

Class SetupApiWrapper
private 
	dll As *DllLoaderClass

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 DllLoaderClass("setupapi",5)
		dll->RegistFunc(VarPtr(SetupDiGetClassDevs),   "SetupDiGetClassDevsA")
		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)
	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


Sleep(-1)
/*
	dwMemberIndex = 0;
		while (SetupDiEnumDeviceInfo
		       (DeviceInfoSet, dwMemberIndex++, &DeviceInfoData)) {
			TCHAR szFriendlyName[MAX_PATH];
			TCHAR szPortName[MAX_PATH];
			DWORD dwReqSize = 0;
			DWORD dwPropType;
			DWORD dwType = REG_SZ;
			HKEY hKey = NULL;

			bRet = SetupDiGetDeviceRegistryProperty(DeviceInfoSet,
			                                        &DeviceInfoData,
			                                        SPDRP_FRIENDLYNAME,
			                                        &dwPropType,
			                                        (LPBYTE)
			                                        szFriendlyName,
			                                        sizeof(szFriendlyName),
			                                        &dwReqSize);

			hKey = SetupDiOpenDevRegKey(DeviceInfoSet,
			                            &DeviceInfoData,
			                            DICS_FLAG_GLOBAL,
			                            0, DIREG_DEV, KEY_READ);
			*/


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