参照関係を調べる時に使うルーチン Public Function RoutineImmediateStringCat(InLineString As String, OutLineString As String) As Long '*-* 即値 の文字列をヌルに書き換える Dim As String BString 'Dim As String CH22String Dim As Long IAA, IBB, iModeLong RoutineImmediateStringCat = 0 iModeLong = 0&: 'CH22String = Chr$(&H22) OutLineString = "" For IAA = 1& To Len(InLineString) BString = Mid$(InLineString, IAA, 1): IBB = Asc(BString) Select Case iModeLong Case 0& If (IBB = &H22) Then iModeLong = 10& OutLineString = OutLineString + BString Else OutLineString = OutLineString + BString End If Case 10& If (IBB = &H22) Then iModeLong = 0& OutLineString = OutLineString + BString End If End Select Next IAA End Function
ロボッチチェックに引っかかってちょっと分割する。 Public Function RoutineCommentLineCat(InLineString As String, OutLineString As String) As Long Const TakaSubRoutineNo as long = 21& '*-* コメント行をヌルに置き換える
Dim As String BString 'Dim CH22String 大域 Dim As Long IAA, IBB, iModeLong
RoutineCommentLineCat = 0 'CH22String = Chr$(&H22) OutLineString = Trim$(InLineString) If (Left$(OutLineString, 1&) = "'") Then OutLineString = "" ElseIf (InStr(OutLineString, CH22String) <= 0&) Then IAA = InStr(OutLineString, ": '") If (IAA > 0&) Then OutLineString = Left$(OutLineString, IAA - 1&) IAA = InStr(OutLineString, " '") If (IAA > 0&) Then OutLineString = Left$(OutLineString, IAA - 1&) OutLineString = Trim$(OutLineString) If (Right$(OutLineString, 1) = ":") Then OutLineString = Trim$(Left$(OutLineString, Len(OutLineString) - 1&))
ElseIf (InStr(OutLineString, "'") <= 0&) Then Else iModeLong = 0& For IAA = 1& To Len(OutLineString) BString = Mid$(OutLineString, IAA, 1) IBB = Asc(BString) Select Case iModeLong Case 0& If (IBB = &H22) Then iModeLong = 10& ElseIf (BString = "'") Then OutLineString = Left$(OutLineString, IAA - 1&) Exit For End If Case 10& If (IBB = &H22) Then iModeLong = 0& End If Case Else '障害 End Select Next IAA OutLineString = Trim$(OutLineString) If (Right$(OutLineString, 1) = ":") Then OutLineString = Trim$(Left$(OutLineString, Len(OutLineString) - 1&)) End If End Function
>>8-9 を受けて、Function 文から Sub 文への変更の可能性について検討を始めた。 と言っても、自己書き換えルーチン用。 Function 文指定ルーチンのうち、Subroutine に書き換え可能なルーチンは、戻り値が一定値ある必要がある。 参照する必要性がない値を返す場合に限られる。混乱を避けるために専用の型を用意した。 Type Wata As Long 綿は、C:\FbEdit\ や C:\tool\FbEdit\ 内 *.BIファイルに使われていないし、http://www.freebasic.net/ 内にも発見できなかったから、今後使われる見込みがないと見当がつく。 変数型、Wata を指定した。 Public Function taka00_CommonStringSet(ByVal hWin As HWND) as Wata のように、CALL 文参照可能なサブルーチンは、戻り値の型を綿とした。 今度は、サブルーチン内で、 taka00_CommonStringSet = 0 という定義以外の定義があるルーチンは、別の型にしなければならない。 前スレでは、戻り値に障害メッセージ番号を返すように、という指摘があった。 返すようにルーチンを作ったものもあるが、せいぜい数十個ぐらいで数が少ないので、 以前のように、 外部出力として障害を積み上げてゆく(Fotran の Write (4, *) システムコンソールへの障害情報表示)か 障害があってもそのまま強行してしまうか ある期間障害の発生個数を記録して、読み出せるようにするか、 どれを選択するか、迷っているところ。
>>20 type Complex private: _real as double _imag as double
public: '' member functions. declare const property Real() as double declare property Real(byval value as double) declare const property Imag() as double declare property Imag(byval value as double)
declare operator +=(byref value as const Complex) end type
'' non-member operators. declare operator +(byref lvalue as const Complex, byref rvalue as const Complex) as Complex
Declare Function AAAA OverLoad (InA1 As Long, InA2 As Long, InA3 As Long) As Long Declare Function AAAA OverLoad (InA1 As Long, InA2 As Long) As Long Declare Function AAAA(InA() As Long) As Long
と、OverLoad 句のついている Declare を先に、ついていないDeclare文を後ろにと、並べないとエラーになる。 間に別の名称の文を入れても解釈してくれるみたい。 Declare Function AAAA OverLoad (InA1 As Long, InA2 As Long, InA3 As Long) As Long Declare Function AAAA OverLoad (InA1 As Long, InA2 As Long) As Long Declare Function BBBB(InA() As Long) As Long Declare Function AAAA(InA() As Long) As Long
>>23 つづき。 Declare Function IniFileRead OverLoad(FileString As String, SecNameString As String, KeyNameString As String, ByRef KeyValString As String) As Wata (一致部分略), ByRef KeyValLong as Long) As Wata , ByRef KeyValDouble As Double) As Wata , ByRef KeyValShort As SHORT) As Wata , ByRef KeyValSingle as Single) As Wata , ByRef KeyValByte As Byte) As Wata , ByRef KeyValInteger As Integer) As Wata , ByRef KeyValLongint As Longint) As Wata , ByRef KeyValLong as ULong) As Wata , ByRef KeyValShort As USHORT) As Wata , ByRef KeyValByte As UByte) As Wata , ByRef KeyValInteger As UInteger) As Wata , ByRef KeyValLongint As ULongint) As Wata , ByRef KeyValString As ZString) As Wata , ByRef KeyValString As WString) As Wata Declare Function IniFileRead OverLoad(FileString As String, SecNameString As String, KeyNameString As String, ByRef KeyValBool As Boolean) As Wata と宣言して、 BString =DataKeyName + str$(ICC) TakaDammyReturnCode = IniFileRead(SoseFileListFile, DataEriaSecName, BString, CString) TakaDammyReturnCode = IniFileRead(SoseFileListFile, DataEriaSecName, DataKeyName + str$(ICC), SoseFileList(ICC)) と参照したら ..\Kako02\Mod\Taka05.bas(3439) error 97: Ambiguous call to overloaded function, INIFILEREAD() in 'TakaDammyReturnCode = IniFileRead(SoseFileListFile, DataEriaSecName, BString, CString)' ..\Kako02\Mod\Taka05.bas(3440) error 97: Ambiguous call to overloaded function, INIFILEREAD() in 'TakaDammyReturnCode = IniFileRead(SoseFileListFile, DataEriaSecName, DataKeyName + str$(ICC), SoseFileList(ICC))' とエラーになった。 内容を調べていない。 使わない(使い方がわからない)変数型を消してみてどうなるか、 面倒だと思ったらば、Overload化をやめて元の状態に戻す予定。
>>33 つづき Function IniFileReadなんたら と Declare Function IniFileRead OverLoad(FileString As String, SecNameString As String, KeyNameString As String, , ByRef KeyValString As ZString) As Wata を抜いて IniFileRead OverLoad → IniFileRead14 に戻したらば、発生しなくなった。16個以下なのか、 As String と As ZString の混用が認められないのか は、調べていない。
Public Function MacinNameGet(MnameString as string) as string Const TakaSubRoutineNo as long = 14& '*-* コンピュータ名を取得
'const MAX_COMPUTERNAME_LENGTH = 15 Dim strComputerNameBuffer As ZString * MAX_COMPUTERNAME_LENGTH = "123456789012345" Dim lngComputerNameLength As Dword = MAX_COMPUTERNAME_LENGTH 'Dim lngComputerNameLengthPtr As LPDWORD 'Dim strComputerNameBufferPtr As LPSTR Dim lngResult As Long
'lngComputerNameLengthPtr = @lngComputerNameLength 'strComputerNameBufferPtr = @strComputerNameBuffer 'TakaDammyReturnCode4 = TakaErrorPointSach(IniNameString, TakaSubRoutineNo) ' コンピュータ名の長さを設定 lngComputerNameLength = Len(strComputerNameBuffer) ' コンピュータ名を取得 'declare function GetComputerNameA(byval lpBuffer as LPSTR, byval nSize as LPDWORD) as WINBOOL 'declare function GetComputerNameW(byval lpBuffer as LPWSTR, byval nSize as LPDWORD) as WINBOOL 'lngResult = GetComputerName(strComputerNameBuffer, lngComputerNameLength) : 'ハング lngResult = GetComputerName(@strComputerNameBuffer, @lngComputerNameLength) lngResult = GetComputerName(@strComputerNameBuffer, @lngComputerNameLength) 'lngResult = GetComputerName(strComputerNameBufferPtr, lngComputerNameLengthPtr) 'lngResult = GetComputerName(strComputerNameBufferPtr, lngComputerNameLengthPtr) MnameString = strComputerNameBuffer 'MnameString = Left$(strComputerNameBuffer, InStr(strComputerNameBuffer, vbNullChar) - 1) MacinNameGet = MnameString End Function
Why have I been blocked? This website is using a security service to protect itself from online attacks. The action you just performed triggered the security solution. There are several actions that could trigger this block including submitting a certain word or phrase, a SQL command or malformed data. What can I do to resolve this? You can email the site owner to let them know you were blocked. Please include what you were doing when this page came up and the Cloudflare Ray ID found at the bottom of this page. なんだわ。 'キーの中の値を列挙します function RegEnumValue で探して 'http://www.freebasic.net/ 内になし 'ドイツサイトより 'https://www.freebasic-portal.de/code-beispiele/system/serielle-schnittstellen-com-ports-unter-windows-ermitteln-248.html があって、コピーしたわ。 UPしたら、引っかかってしまった。
Dim hKey As HANDLE 'Dim Ierror As Integer 'type LPCSTR as const zstring ptr Dim SubKeyZString As ZString * 1024 Dim SubKeyZStringPtr As LPCSTR Dim KeyValStringTSU As Long, KeyValStringSU As Long, Jerror As Long SubKeyZStringPtr = @SubKeyZString
'Schlussel offnen; Fehlermeldung ausgeben und Programm beenden falls nicht erfolgreich 'キーは開きます;エラー・メッセージは、うまくいかなければプログラムを終えます 'const KEY_QUERY_VALUE = &h0001 ''サブキーのデータを問い合わせることを許可します。 'declare function RegOpenKeyExA(byval hKey as HKEY, byval lpSubKey as LPCSTR, byval ulOptions as DWORD, byval samDesired as REGSAM, byval phkResult as PHKEY) as LONG 'declare function RegOpenKeyExW(byval hKey as HKEY, byval lpSubKey as LPCWSTR, byval ulOptions as DWORD, byval samDesired as REGSAM, byval phkResult as PHKEY) as LONG
Ierror = ERROR_SUCCESS KeyValStringTSU = 10 KeyValStringSU = 0 Redim KeyValString(KeyValStringTSU) As String, KeyNameString(KeyValStringTSU) As String 'Ierror = RegOpenKeyEx(HKEY_LOCAL_MACHINE, @"HARDWARE\DEVICEMAP\SERIALCOMM", 0, KEY_QUERY_VALUE, @hKey) Ierror = RegOpenKeyEx(RootKey, @SubKeyZString, 0, KEY_QUERY_VALUE, @hKey) If (Ierror = ERROR_SUCCESS) Then Dim comCnt As Integer 'レジストリエントリの数 Dim As String comStrString 'レジストリエントリ名の最長の長さ(文字型) Dim As String comPortString 'レジストリエントリのデータの最長の長さ(文字型) Dim As Integer comStrLen Dim As Integer comPortLen Dim As Integer comStrMaxLen 'レジストリエントリ名の最長の長さ Dim As Integer comPortMaxLen 'レジストリエントリのデータの最長の長さ
'鍵となる問題の局面情報 Groseninformationen des Schlussels abfragen '指定されたレジストリキーに関する情報を取得します。 'declare function RegQueryInfoKeyA((中略, C:\FreeBASIC\inc\win\winreg.bi 参照)byval lpftLastWriteTime as PFILETIME) as LONG 'declare function RegQueryInfoKeyW((中略), byval lpftLastWriteTime as PFILETIME) as LONG
KeyValStringTSU = comCnt + 1 KeyValStringSU = 0 Redim KeyValString(KeyValStringTSU) As String, KeyNameString(KeyValStringTSU) As String Dim IQQ As Integer
For IQQ = 0 To comCnt - 1 comStrLen = comStrMaxLen + 1 'String文字数 → ZString文字数 comPortLen = comPortMaxLen / 2 'ANSI → UNICODE 文字数 'Schlusselname und -wert ermitteln und ausgeben; Fehlermeldung ausgeben wenn nicht erfolgreich 'オープンレジストリキーから値の列挙 'declare function RegEnumValueA(byval hKey as HKEY, byval dwIndex as DWORD, byval lpValueName as LPSTR, byval lpcchValueName as LPDWORD, byval lpReserved as LPDWORD, byval lpType as LPDWORD, byval lpData as LPBYTE, byval lpcbData as LPDWORD) as LONG 'declare function RegEnumValueW(byval hKey as HKEY, byval dwIndex as DWORD, byval lpValueName as LPWSTR, byval lpcchValueName as LPDWORD, byval lpReserved as LPDWORD, byval lpType as LPDWORD, byval lpData as LPBYTE, byval lpcbData as LPDWORD) as LONG
多分動くと思うけど、ライブ化のための整理前の状態でup Public Function RegistrySubKeyList(RootKey as HKEY, TopSubKeyString As String, SubKeyNameString() As String, Ierror As Long) As Wata 'Subキーの名を列挙します 'http://madia.world.coocan.jp/vb/API/RegEnumKeyEx.htm
Dim hKey As HANDLE Dim SubKeyZString As ZString * 1024 Dim SubKeyZStringPtr As LPCSTR SubKeyZStringPtr = @SubKeyZString Dim Jerror As Long
ElseIf (Left$(TopSubKeyString, 1) = "\") Then 'Ret = 161(指定されたパスは無効です) 発生 Else 'Fun RegQueryInfoKey() 用変数 'Dim As DWORD ClassBuffSize 'クラス文字列バッファのサイズ (MS指示: 0を指定する) Dim as DWORD SubKeysSU 'サブキーの数 Dim as DWORD SubKeysMaxLen 'サブキー名の最長の長さ Dim as DWORD ClassMaxLen 'クラス文字列の最長の長さ Dim as DWORD KeyNameSU 'レジストリエントリの数 Dim as DWORD KeyNameMaxLen 'レジストリエントリ名の最長の長さ Dim as DWORD KeyValMaxLen 'レジストリエントリのデータの最長の長さ Dim as DWORD SecurityLen 'セキュリティ記述子の長さ Dim LastWriteTime As FILETIME '最後の書き込み時刻
SubKeyZString = TopSubKeyString Dim SubKeyNameStringTSU as Long, SubKeyNameStringSU As Long SubKeyNameStringTSU = 100 SubKeyNameStringSU = 0 Redim SubKeyNameString(SubKeyNameStringTSU)
Const MojiLen As Long = 1024 Dim IQQ as DWORD 'サブキーのインデックス番号 Dim SubKeysNameBuffZString As ZString * MojiLen 'サブキー名が格納されるバッファ Dim SubKeysNameBuffSize As DWORD = MojiLen 'サブキー名バッファのサイズ 'Dim ClassBuff As ZString * MojiLen 'クラス文字列バッファ MS指定 0 'Dim ClassBuffSize as DWORD 'クラス文字列バッファのサイズ MS指定 0 Dim FileWriteTime As FILETIME '最終更新時刻
End If '初期化する SubKeysNameBuffZString = "" SubKeysNameBuffSize = MojiLen: 'Len(SubKeysNameBuffZString)
Next IQQ Else 'MessageBox(TakaHWND,"Hello RegQueryInfoKey Error."+Str$(Jerror),"Messagebox caption",MB_ICONINFORMATION) End If 'ハンドルを解放 RegCloseKey(hKey) Else 'MessageBox(TakaHWND,"Hello RegOpenKeyEx Error."+Str$(Ierror),"Messagebox caption",MB_ICONINFORMATION) End If End If End Function
'C:\tool\FreeBASIC\inc\win\secext.bi 内指定値 'declare function GetUserNameExA(byval NameFormat as EXTENDED_NAME_FORMAT, byval lpNameBuffer as LPSTR, byval nSize as PULONG) as WINBOOLEAN 'declare function GetUserNameExW(byval NameFormat as EXTENDED_NAME_FORMAT, byval lpNameBuffer as LPWSTR, byval nSize as PULONG) as WINBOOLEAN 'type EXTENDED_NAME_FORMAT as long 'enum '(中略) 'end enum 'type PEXTENDED_NAME_FORMAT as EXTENDED_NAME_FORMAT ptr
に関係して、 '#Include Once "win/secext.bi" 指定以外の#Include文が必要らしく、コンパイラーが通らない。型宣言が '#Include Once "win/bcrypt.bi" '#Include Once "win/ntdef.bi" に同一な宣言があるけど、どっちを使ってよいものかわからない。どちらか入れてもコンパイルエラーになる。 したがって、GetUserNameEx()が使えない。 部分切り出しという手法もある。
declare function SHGetKnownFolderPath(byval rfid as const KNOWNFOLDERID const ptr, byval dwFlags as DWORD, byval hToken as HANDLE, byval ppszPath as PWSTR ptr) as HRESULT の解読中。
作成したソフトの中身を眺めた範囲では、 Open InFileString For Input Encoding "utf-16" As #InFileNo While - Wend で回して、先頭1文字又は先頭3文字で作業内容を決定 一番最初の[]内でルートキーを取得し その後は[でサブキー名、"や@でキー名、=がない場合にはキー値の追記行として処理 だから、そんな難しいルーチンではないと思う。 サブキー、キー名、キー値の3つがそろったところ、つまり、サブキーの先頭行か、キー名の先頭行で検索する