【QBASIC互換!?】FreeBasic【GPL】 2 [無断転載禁止]©2ch.net

【QBASIC互換!?】FreeBasic【GPL】 2 [無断転載禁止]©2ch.net (435ﾚｽ)
上下前次1-新
抽出解除必死ﾁｪｯｶｰ(本家) (べ) 自ID ﾚｽ栞あぼーん

72: 2017/02/18(土)07:01 ID:/R2Xi7hr(1/10) AAS
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　で探して
'外部ﾘﾝｸ:www.freebasic.net 内になし
'ドイツサイトより
'外部ﾘﾝｸ[html]:www.freebasic-portal.de
があって、コピーしたわ。
UPしたら、引っかかってしまった。

73: 2017/02/18(土)07:06 ID:/R2Xi7hr(2/10) AAS
分割すれば何とかなるかもしれぬから、20行ぐらいづつやってみる。
Public Function RegistryKeyList(RootKey as HKEY, SubKeyString As String, KeyNameString() As String, KeyValString() As String, Ierror As Long) As Wata
'キーの中の値を列挙します
'外部ﾘﾝｸ:www.freebasic.net 内になし
'ドイツサイトより
'外部ﾘﾝｸ[html]:www.freebasic-portal.de

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

RegistryKeyList = 0
'SubKeyString = "HARDWARE\DEVICEMAP\SERIALCOMM": '保守用
'RootKey = HKEY_LOCAL_MACHINE: '保守用

SubKeyZString = SubKeyString

74: 2017/02/18(土)07:08 ID:/R2Xi7hr(3/10) AAS
'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 'レジストリエントリのデータの最長の長さ

75: 2017/02/18(土)07:13 ID:/R2Xi7hr(4/10) AAS
'鍵となる問題の局面情報 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

RegQueryInfoKey(hKey, 0, 0, 0, 0, 0, 0, @comCnt, @comStrMaxLen, @comPortMaxLen, 0, 0)
comStrString = String(comStrMaxLen, 0)
comPortString = String(comPortMaxLen, 0)

KeyValStringTSU = comCnt + 1
KeyValStringSU = 0
Redim KeyValString(KeyValStringTSU) As String, KeyNameString(KeyValStringTSU) As String
Dim IQQ As Integer

76(1): 2017/02/18(土)07:15 ID:/R2Xi7hr(5/10) AAS
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

Jerror = RegEnumValue(hKey, IQQ, StrPtr(comStrString), @comStrLen, 0 , 0, StrPtr(comPortString), @comPortLen)

77(1): 2017/02/18(土)07:18 ID:/R2Xi7hr(6/10) AAS
If Jerror = ERROR_SUCCESS Then
KeyValStringSU = KeyValStringSU + 1
KeyValString(KeyValStringSU) = Left(comPortString, comPortLen)
KeyNameString(KeyValStringSU) = Left(comStrString, comStrLen)
ドイツ語のPrint文消してみた

78: 2017/02/18(土)07:19 ID:/R2Xi7hr(7/10) AAS
Else
'レジストリキーを読み取りでエラーが発生しました
'Print "Fehler beim Auslesen des Registry Keys (Error"; Ierror; " bei Index"; IQQ; ")"
Ierror = Jerror
EndIf
Next
'Schlussel schliesen
RegCloseKey(hKey)

'Print comCnt; " COM-Ports vorhanden"
'TakaBuff = "COM-Ports :" + Str$(comCnt)
'SetDlgItemText(TakaHWND, IDC_STC1, @TakaBuff): '枠表示用バッファ

79: 2017/02/18(土)07:22 ID:/R2Xi7hr(8/10) AAS
Else
'Print "Registry Keys Open (Error"; Ierror; ")"
'TakaBuff = "OpenError :" + Str$(Ierror)
'SetDlgItemText(TakaHWND, IDC_STC1, @TakaBuff): '枠表示用バッファ
EndIf
End Function

で終わり。使いたい人は適当に使って。

80: 2017/02/18(土)07:31 ID:/R2Xi7hr(9/10) AAS
このドイツ語サイトでは、'ANSI から UNICODE へ文字数の換算をしている。
FreeBasic では、区別ないで、declare 文を切り替えて使っているので、おかしくなるかもしれないし、
この参照元の著者が考慮しているのかもしれない。
それと、2バイト文字については考慮していないかもしれない。

>>77 で消したプリント文は全角で送ってみる
　　　　　　’Ｐｒｉｎｔ　Ｌｅｆｔ（ｃｏｍＰｏｒｔＳｔｒｉｎｇ，　ｃｏｍＰｏｒｔＬｅｎ）　＋　Ｃｈｒ（９）　＋　Ｌｅｆｔ（ｃｏｍＳｔｒＳｔｒｉｎｇ，　ｃｏｍＳｔｒＬｅｎ）

81: 2017/02/18(土)07:53 ID:/R2Xi7hr(10/10) AAS
このドイツ語サイトで゜気になるのは、>>76
RegEnumValue(hKey, IQQ, StrPtr(comStrString), @comStrLen,
Dim IQQ As Integer （For 文内に有った宣言だが、自作宣言チェックルーチンが解釈できない(Dim 文だけ先読みして使用する変数をルーチン別に一覧表を作る)ので移動）
RegEnumValueW(byval hKey as HKEY, byval dwIndex as DWORD,
変数型　DWORDを使うところをInteger で参照している。
Integerは、32Bit符号付整数又は64Bit符号付整数
外部ﾘﾝｸ[html]:makoto-watanabe.main.jp
Dword は、32Bit符号無整数
外部ﾘﾝｸ[html]:makoto-watanabe.main.jp
なので、引数の換算ルーチン次第でおかしなことが起こりうる。

上下前次1-新書関写板覧索設栞歴

ｽﾚ情報赤ﾚｽ抽出画像ﾚｽ抽出歴の未読ｽﾚ AAｻﾑﾈｲﾙ

ぬこの手ぬこTOP 0.029s