X



【QBASIC互換!?】FreeBasic【GPL】 2 [無断転載禁止]©2ch.net
0001デフォルトの名無しさん
垢版 |
2016/12/24(土) 12:22:27.77ID:CVYSyiU+
FreeBasic
ttp://www.freebasic.net/

建てたいって人がいたので勝手に建てた
後はご自由にどうぞ
俺は知らん
過去スレ
http://echo.2ch.net/test/read.cgi/tech/1139379786/
0058デフォルトの名無しさん
垢版 |
2017/02/04(土) 13:36:06.91ID:y1MEdiWu
>>57
>オレのようにばかげたことをやっている人間がいると、
>オレに比べて頭が良いんだ、という人が多数表れて、普及が進む。
>だけど、高度なことばかりやっていると普及しない。
そういうのは、世間一般では屁理屈を捏ねるっていうのだよ
掲示板において自分勝手に振る舞うための自己中心的な勝手な解釈にしかなっていない
そんなのは公共スペースである掲示板には断じて必要ない、肥やしにもならないクソ未満だよ

>商品云々
先生ー、意味が分かりませーん
C/C++、.NET、Javaなど、現行の主な言語を扱うための環境づくりは無料で出来ますがー?
大昔にQBASICとかは販売されていたけど、何時の時代の話をしているのですかー?

というわけで、これまでの指摘に対して何も言及しないのは
この掲示板において君のスタンスは変わらないってことで良いのかな?
そうであれば、こっちも次のフェイズに移行するけど、きっちりと言及してくれないかな
0059デフォルトの名無しさん
垢版 |
2017/02/05(日) 07:03:10.62ID:j48wRVTG
>>58 >先生ー、意味が分かりませーん
先生からは、
意味が分かりなさい

>何も言及しないの
しているじゃない。
0060デフォルトの名無しさん
垢版 |
2017/02/05(日) 09:06:21.85ID:9D2c4niI
>>59
君のは言及とは言わない、屁理屈を捏ねて話を逸らかしているだけ
本当に対話の出来ない人なんだな
君のスタンスは、

・こっちの提案に聞く耳持たない
・このスレを私物化する気満々

って解釈するね
0061デフォルトの名無しさん
垢版 |
2017/02/05(日) 09:39:32.87ID:9D2c4niI
このスレは、スレを私物化する屁理屈大先生専用スレとなりました


------------------------------------------------------------------------
ここからは、屁理屈大先生の独演会をお楽しみ下さい
0062渡辺真
垢版 |
2017/02/07(火) 20:43:31.22ID:TSI9i7c8
一年ぶりに、FreeBASIC 日本語版マニュアルを更新しました。
2016年末までの英文版 Wiki の変更を反映したつもりです。
http://makoto-watanabe.main.jp/freebasic/

CHM 版は、下記でダウンロードできます。
http://makoto-watanabe.main.jp/freebasic/FB-manualJP20170207.zip

修正すべき点、加筆すべき点など、ご指摘、ご意見を、お願いいたします。
FreeBASIC で遊んでみて下さい。
0063デフォルトの名無しさん
垢版 |
2017/02/07(火) 21:55:22.71ID:/LDN5Se3
>>61 大先生専用スレ
おほめいただきありがとうございます。
アルバイトで1年半ほど教員のまねごとをしていましたが、
当時の先生から大先生へと進歩しました。

思い起こせば、2次方程式の解を求めていた高校から始まる Basic の世界です。
この歳になって、当時のBasicの教科書には常に記載されていた MAT 命令を使うことができるようになりました。

MAT演算で何をしようか、思い当たるものがないんだよ。
細かいことは、gsl_matrix.bi参照。
欠損がないことを前提条件にすれば、結構いろいろできるのだが
0064デフォルトの名無しさん
垢版 |
2017/02/08(水) 01:11:06.62ID:Okfj9LEa
MATならば、Fortran90/95では、標準で実装されていて、実際に、ベクトルや行列、連立一次方程式
を解く必要がある場合は、Fortran 90/95を使うほうがいいかもしれません。
まあ、趣味でやる分には、Basicでベクトルや行列、行列式のサブルーチンを
作るのも楽しみですが。
0065デフォルトの名無しさん
垢版 |
2017/02/08(水) 21:53:09.93ID:FL3Yx6+/
>>64 >ベクトルや行列、連立一次方程式を解く必要がある
Foortan 6 用の
> ベクトルや行列、行列式のサブルーチン
ライブラリー SSP01.FTからSSP3?.FT はどこかに入っています。
かなりの内容を V.B.に移植して使っていました。

今迷っているのは、何のデータを使って、ベクトルや行列、連立一次方程式を解くかといしうこと。
代数関係の公式などは、すべて、
データの欠落がない
データの繰り返しは同じ回数である
データの有効桁は無限長である
ことを前提に成り立っています。手持ちのデータでは、
欠落が多数(データどりを忘れた等)
繰り返しはなし
有効桁はせいぜい2桁。0.5単位で30位まで。
稀に50-60位まで増えるが異常値と解釈したほうが正しい。

なんてものしかない。最近は変な偏りが出てくるようになったし。
http://www1.river.go.jp/
http://www1.river.go.jp/cgi-bin/SelectMapSite.exe
0066デフォルトの名無しさん
垢版 |
2017/02/08(水) 23:46:18.64ID:Okfj9LEa
いわゆるill conditionの連立一次方程式などでは、解法によって解がちがったりして
結構勉強になるとおもいます。
0067デフォルトの名無しさん
垢版 |
2017/02/10(金) 21:11:05.10ID:M676Jk5z
>>66 悪条件な連立方程式は、
線形代数の教科書に載っていた有名な方程式
とか、デカコンを使っていたころに色々やりました。
だから、手持ちのライブには、その頃の名残として、
対角化、三重対角化、LP(線型計画法)
等のルーチンも存在します。
有効桁が無限でないと、発散して解けない問題とかありました。
http://www.math.ritsumei.ac.jp/yasutomi/jugyo/Numerical_Analysis/note5.pdf
0069デフォルトの名無しさん
垢版 |
2017/02/15(水) 21:32:33.07ID:IWmGzwYn
>>67 つづき。
行列式のまともな計算方法がある。詳しいことは
http://w3e.kanazawa-it.ac.jp/math/category/gyouretu/senkeidaisu/henkan-tex.cgi?target=/math/category/gyouretu/senkeidaisu/index.html
内を探してくれ。

http://www.cis.twcu.ac.jp/~nagasima/02sek4.pdf
一つの列の定数倍を他の列に加えても行列式の値は変わらない
一つの列の各要素をc倍すると行列式の値はc倍になる
二つの列を入れ替えると行列式の値は−1倍になる
という性質をうまく使って、入れ替えの回数と、全体にかけた倍数を記録しておいて
上三角又は下三角行列に書き換える。
http://tau.doshisha.ac.jp/lectures/2005.linear-algebra-I/html.dir/node77.html
対角の積で行列式の値を求められる。
こんなことが、高校の線形代数の副読本に書いてあったものだから

手持ちのライブには、三角化ルーチンと、三角化することを使った行列式の解法ルーチンがある。
これ、評判悪いんだよ。
まともな方法を使わないで、n次まで拡張してしまったから。
0070デフォルトの名無しさん
垢版 |
2017/02/17(金) 00:32:22.98ID:vt14Y6ZI
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
0071デフォルトの名無しさん
垢版 |
2017/02/17(金) 00:34:56.14ID:vt14Y6ZI
コンピュータ名を取得 で、なぜか
lngResult = GetComputerName(@strComputerNameBuffer, @lngComputerNameLength)
lngResult = GetComputerName(@strComputerNameBuffer, @lngComputerNameLength)
とか
'lngResult = GetComputerName(strComputerNameBufferPtr, lngComputerNameLengthPtr)
'lngResult = GetComputerName(strComputerNameBufferPtr, lngComputerNameLengthPtr)
のように、2回参照しないとコンピュータ名を取得できない。
なお、変数名については、当時のMS系サイトの内容をそのまま使っている。
0072デフォルトの名無しさん
垢版 |
2017/02/18(土) 07:01:46.64ID:/R2Xi7hr
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したら、引っかかってしまった。
0073デフォルトの名無しさん
垢版 |
2017/02/18(土) 07:06:22.38ID:/R2Xi7hr
分割すれば何とかなるかもしれぬから、20行ぐらいづつやってみる。
Public Function RegistryKeyList(RootKey as HKEY, SubKeyString As String, KeyNameString() As String, KeyValString() As String, Ierror As Long) As Wata
'キーの中の値を列挙します
'http://www.freebasic.net/ 内になし
'ドイツサイトより
'https://www.freebasic-portal.de/code-beispiele/system/serielle-schnittstellen-com-ports-unter-windows-ermitteln-248.html

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
0074デフォルトの名無しさん
垢版 |
2017/02/18(土) 07:08:25.80ID:/R2Xi7hr
'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 'レジストリエントリのデータの最長の長さ
0075デフォルトの名無しさん
垢版 |
2017/02/18(土) 07:13:29.01ID:/R2Xi7hr
'鍵となる問題の局面情報 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
0076デフォルトの名無しさん
垢版 |
2017/02/18(土) 07:15:43.63ID:/R2Xi7hr
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)
0077デフォルトの名無しさん
垢版 |
2017/02/18(土) 07:18:23.68ID:/R2Xi7hr
If Jerror = ERROR_SUCCESS Then
KeyValStringSU = KeyValStringSU + 1
KeyValString(KeyValStringSU) = Left(comPortString, comPortLen)
KeyNameString(KeyValStringSU) = Left(comStrString, comStrLen)
ドイツ語のPrint文消してみた
0078デフォルトの名無しさん
垢版 |
2017/02/18(土) 07:19:28.87ID:/R2Xi7hr
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): '枠表示用バッファ
0079デフォルトの名無しさん
垢版 |
2017/02/18(土) 07:22:12.51ID:/R2Xi7hr
Else
'Print "Registry Keys Open (Error"; Ierror; ")"
'TakaBuff = "OpenError :" + Str$(Ierror)
'SetDlgItemText(TakaHWND, IDC_STC1, @TakaBuff): '枠表示用バッファ
EndIf
End Function

で終わり。使いたい人は適当に使って。
0080デフォルトの名無しさん
垢版 |
2017/02/18(土) 07:31:41.18ID:/R2Xi7hr
このドイツ語サイトでは、'ANSI から UNICODE へ文字数の換算をしている。
FreeBasic では、区別ないで、declare 文を切り替えて使っているので、おかしくなるかもしれないし、
この参照元の著者が考慮しているのかもしれない。
それと、2バイト文字については考慮していないかもしれない。

>>77 で消したプリント文は全角で送ってみる
      ’Print Left(comPortString, comPortLen) + Chr(9) + Left(comStrString, comStrLen)
0081デフォルトの名無しさん
垢版 |
2017/02/18(土) 07:53:30.15ID:/R2Xi7hr
このドイツ語サイトで゜気になるのは、>>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符号付整数
http://makoto-watanabe.main.jp/freebasic/PgInteger.html#start
Dword は、32Bit符号無整数
http://makoto-watanabe.main.jp/freebasic/PgUlong.html#start
なので、引数の換算ルーチン次第でおかしなことが起こりうる。
0082デフォルトの名無しさん
垢版 |
2017/02/19(日) 08:24:54.20ID:hFztBwNz
以前紹介のあったレジストリーの読み取れルーチン
'http://makoto-watanabe.main.jp/freebasic/tipsRegistry.html
'名称変更して ReadRegistry() → RegistryRead02()となっている。
2016.09にレジストリーエディタを使って、レジストリーのダンプリストを作成。
その中から、「Mozilla/」「User Agent」「UserAgent」を検索して見つかったレジストリーパスを読み取っている。
'[HKEY_CURRENT_USER\(何かの文字\)Software\Microsoft\Windows\CurrentVersion\Internet Settings]
と'サブキーを取得して、その後に同じディレクトリーを付け足してUserAgentの内容を読み取る場合が多い。
しかも、一部内容は消えている。何で消えたかなどは不明。
レジストリーのOpen/Closeは成功しているが
RegEnumKeyEx(hKey, IQQ, StrPtr(Moji), @Nagasa, 0, 0, 0, @File)
の実行で、エラー234が発生している。
0083渡辺真
垢版 |
2017/02/19(日) 12:25:56.17ID:lCfIxkgx
GSL(科学技術計算関数ライブラリ) のプログラム例を日本語化しました。
http://makoto-watanabe.main.jp/freebasic/tipsGSL.html

数学的な意味について、私は理解できないのですが、プログラムとしては、動きました。
0084デフォルトの名無しさん
垢版 |
2017/02/19(日) 16:57:53.28ID:hFztBwNz
http://madia.world.coocan.jp/vb/API/RegEnumKeyEx.htm
を見本に、サブキー取得ルーチンを作っていた。
>>82
egEnumKeyEx(hKey, IQQ, StrPtr(Moji), @Nagasa, 0, 0, 0, @File)の実行で、エラー234が発生している。
の原因がやっとわかった。
Nagasa = Len(Moji)
では、常に Nagasa = 0となる。
Const MojiLen As Long = 1024
Dim SubKeysNameBuffZString As ZString * MojiLen 'サブキー名が格納されるバッファ
と定義して
Nagasa = MojiLen
とする必要があった。
0085デフォルトの名無しさん
垢版 |
2017/02/19(日) 17:03:39.05ID:hFztBwNz
多分動くと思うけど、ライブ化のための整理前の状態で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

RegistrySubKeyList = 0

'RootKey = HKEY_LOCAL_MACHINE '(保守用)
'TopSubKeyString = "BCD00000000\Objects": '(保守用) 前後の「\」なし
'TopSubKeyString = "SYSTEM\CurrentControlSet\Services\xmlprov\Parameters\SchemaGroups\User"
'TopSubKeyString = "SYSTEM\CurrentControlSet"
'RootKey = HKEY_CURRENT_USER
'TopSubKeyString = "Software\Microsoft\Windows\CurrentVersion\Internet Settings"
If (TopSubKeyString = "") Then
'Ret = 234(バッファサイズの不足) 発生
0086デフォルトの名無しさん
垢版 |
2017/02/19(日) 17:04:26.69ID:hFztBwNz
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 '最終更新時刻
0087デフォルトの名無しさん
垢版 |
2017/02/19(日) 17:09:40.55ID:hFztBwNz
また引っかかった。。続きはそのうち
0088デフォルトの名無しさん
垢版 |
2017/02/19(日) 17:11:40.75ID:hFztBwNz
’以下の実行文が引っ掛かったみたい。全角にしてみた。
'バッファを確保する
  SubKeysNameBuffZString = ””: ’String(MojiLen, Chr(0))
  SubKeysNameBuffSize = MojiLen: ’Len(SubKeysNameBuffZString)

'キーをオープンしてハンドルを得る
0089デフォルトの名無しさん
垢版 |
2017/02/19(日) 17:13:36.21ID:hFztBwNz
Ierror = RegOpenKeyEx(RootKey, @SubKeyZString, 0, KEY_ALL_ACCESS, @hKey)


If (Ierror = ERROR_SUCCESS) Then
'MessageBox(TakaHWND,"Hello Open 成功","Messagebox caption",MB_ICONINFORMATION)
Jerror = RegQueryInfoKey(hKey, 0, 0, 0, @SubKeysSU, @SubKeysMaxLen, @ClassMaxLen, @KeyNameSU, @KeyNameMaxLen, @KeyValMaxLen, @SecurityLen, @LastWriteTime)
If (Jerror = ERROR_SUCCESS) Then

'MessageBox(TakaHWND,"Hello Info 成功","Messagebox caption",MB_ICONINFORMATION)

'MessageBox(TakaHWND,"Hello SubKeysSU:"+Str$(SubKeysSU)+"SubKeys最大長さ"+Str$(SubKeysMaxLen)+")","Messagebox caption",MB_ICONINFORMATION)
'MessageBox(TakaHWND,"Hello 保存キー数"+str$(KeyNameSU) +"キー名最大長さ"+ Str$(KeyNameMaxLen) +"キー値最大長さ"+ Str$(KeyValMaxLen) +")","Messagebox caption",MB_ICONINFORMATION)
for IQQ = 0 To SubKeysSU -1
'サブキーを取得
SubKeysNameBuffSize = MojiLen
' 1 2 3 4 5 6 7 8
Jerror = RegEnumKeyEx(hKey, IQQ, @SubKeysNameBuffZString, @SubKeysNameBuffSize, 0, 0, 0, @FileWriteTime)

If (Jerror = ERROR_SUCCESS) Then
'MessageBox(TakaHWND,"Hello RegEnumKeyEx 成功("+SubKeysNameBuffZString+") Loop :"+Str$(IQQ),"Messagebox caption",MB_ICONINFORMATION)
0090デフォルトの名無しさん
垢版 |
2017/02/19(日) 17:15:52.10ID:hFztBwNz
>>89 本文が長すぎるというので、コメント行('declare function RegEnumValuなんたら)を消した。
以下の6行は、全角化している
          IF (SubKeyNameStringSU >= SubKeyNameStringTSU) then
            SubKeyNameStringTSU = SubKeyNameStringTSU + 20
            redim preserve SubKeyNameString(SubKeyNameStringTSU)
          End If
          SubKeyNameStringSU = SubKeyNameStringSU + 1
          SubKeyNameString(SubKeyNameStringSU) = SubKeysNameBuffZString
0091デフォルトの名無しさん
垢版 |
2017/02/19(日) 17:16:40.54ID:hFztBwNz
Else
'Jerror = 234(バッファサイズの不足) 発生
'MessageBox(TakaHWND,"Hello RegEnumKeyEx Err:"+Str$(Jerror )+"("+SubKeysNameBuffZString+")","Messagebox caption",MB_ICONINFORMATION)
'MessageBox(TakaHWND,"Hello RegEnumKeyEx Err:"+Str$(Jerror )+"("+Str$(Len(SubKeysNameBuffZString))+"," +Str$(SubKeysNameBuffSize)+")","Messagebox caption",MB_ICONINFORMATION)

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
0092デフォルトの名無しさん
垢版 |
2017/02/19(日) 17:28:43.40ID:hFztBwNz
こんなところ。使いたい人は適当に使って。

内容の読み書き、サブキー名とキー名の取得、
の4ルーチンがあれば、中身を読み取って何とかできると思われる。

>>82のUserAgentのように
途中がちょっと違って、前後が同じパスのレジストリーのデータを読む場合のように、
サブキーを取得して、(値が保存されていることを前提に)適当に読み取るというルーチンを作成できれば
ユーザー名全員の取得が可能となる。

Htmlファイル作成ルーチンの、<META>タグに著者名を指定する場合がある
このときに、著者名を誰で登録するか、の選択をするときぐらいしか使わない。
0093デフォルトの名無しさん
垢版 |
2017/02/21(火) 20:41:01.96ID:qjaAIYLo
'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()が使えない。
部分切り出しという手法もある。
0094デフォルトの名無しさん
垢版 |
2017/02/22(水) 20:16:58.92ID:XWdhAgf/
>>93 つづき
'#Include Once "win/wincrypt.bi"
'#Include Once "win/security.bi"
'の2行が必要と判明した。
0095デフォルトの名無しさん
垢版 |
2017/02/22(水) 20:22:40.74ID:XWdhAgf/
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
の解読中。
0096デフォルトの名無しさん
垢版 |
2017/02/22(水) 21:44:37.32ID:XWdhAgf/
>>95 つづき
#if _WIN32_WINNT = &h0602
の時のみ使えるシステムコールルーチンで、Win10では使えない模様。
よって、開発中止。
0097デフォルトの名無しさん
垢版 |
2017/02/24(金) 20:17:50.91ID:FAsTtcI2
>>96 つづき
何か関係ありそうな内容を探していたら
http://qiita.com/hkuno/items/7b8daa37d9b68e390d7e
という一覧表を見つけた。

バージョンの取得は
http://www.4d.com/jp/blog/get-windows-version.html
参照。
GetFileVersionInfo システムコールは現時点で理解できない。
MSReturnCode = GetVersionExA(@udtOSVersionInfo)
関係情報がMSサイトから消えたので、こちらからの取得はあきらめるしかない模様。
使っていたのが、Win95 → Win2000 に伴うレジストリーの構造の変化だけだったので
NetからWin8を持たないで、Win 10 だけ考えるなら、なくても何とかなりそう。

レジストリエディターで、値をダンプして、検索をかけようとした。
LineInput で読み取ったらば、半角英数として解釈できなかった。
つまり、Shift-JIS コードではなく、Uniコードだった。
0098デフォルトの名無しさん
垢版 |
2017/02/25(土) 21:16:18.91ID:r1nrT1Dg
>>97 つづき。レジストリーのダンプリスト関係。
Const InFile1String = "D:\bas\Projects\Kako02\0RegData\1111.reg.txt"
の調子で入力ファイル5つを昨年(2016.09)に作成した。
レジストリー操作がよくわからなくて放置していたが、Read, Write, SubKey検索, Key検索の4ルーチンが入手できたことから、放置していた、データの収集関係を始めることとした。
が、データが膨大で260MB位ある。初期には
エディタで読み取って、検索
検索ソフトで検索
なんてやっていたが、内容によっては膨大な数の入力定数の設定があり、結構間違いが多数発生した。
というわけで、自動化。キー名、キー値、サブキー名で検索して、一覧表を作成、一覧表から読み取りルーチンを作成するようにした。
Dim As String RegPathString, KeyNameString, KeyValString

'Input File No. 0
(略)
'Input File No. 3 D:\bas\Projects\Kako02\0RegData\3333.reg.txt
(略)
RegPathString = "SOFTWARE\Microsoft\Windows Search\Gathering Manager"
KeyNameString = "UserAgent"
KeyValString = RegistryRead02String(HKEY_LOCAL_MACHINE, RegPathString, KeyNameString)
'KeyValString = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT; MS Search 4.0 Robot)"
'Input File No. 4 D:\bas\Projects\Kako02\0RegData\4444.reg.txt
(略)
てな調子で読み取りルーチンが作成されるソフトを作成した。
0099デフォルトの名無しさん
垢版 |
2017/02/26(日) 13:08:20.87ID:K90trdCC
>>98
つづき。こんなのも作った。
Dim As String TopSubKeyString, BottomSubKeyString, SubKeyNameString()
Dim Ierror As Long

'Input File No. 3 D:\bas\Projects\Kako02\0RegData\3333.reg.txt

' RegPathString = "SOFTWARE\Microsoft\Advanced INF Setup\IE40.UserAgent\RegBackup"
TopSubKeyString = "SOFTWARE\Microsoft\Advanced INF Setup"
BottomSubKeyString = "\RegBackup"
TakaDammyReturnCode = ReadSubKeyList0(HKEY_LOCAL_MACHINE, TopSubKeyString, SubKeyNameString(), Ierror)
' SubKeyNameString(3) = ["IE CompList", "IE.HKCUZoneInfo", "IE40.UserAgent"]
'**********************\(ちょっと違う)\*******************
というサブキー内にちょっと内容が異なる値が保存されている場合を想定。
UserNameの取得で、導入したユーザー名をかき集めるための物。
(ちょっと違う)ところをSubキーとして検索(Function ReadSubKeyList0(なんたら))して、フルスペルを取得。
個別に各キーの値を取得するための、Subキー一覧を作成するための物
0100デフォルトの名無しさん
垢版 |
2017/02/26(日) 13:18:03.93ID:K90trdCC
作成したソフトの中身を眺めた範囲では、
Open InFileString For Input Encoding "utf-16" As #InFileNo
While - Wend で回して、先頭1文字又は先頭3文字で作業内容を決定
一番最初の[]内でルートキーを取得し
その後は[でサブキー名、"や@でキー名、=がない場合にはキー値の追記行として処理
だから、そんな難しいルーチンではないと思う。
サブキー、キー名、キー値の3つがそろったところ、つまり、サブキーの先頭行か、キー名の先頭行で検索する
0101デフォルトの名無しさん
垢版 |
2017/02/26(日) 13:25:38.25ID:K90trdCC
>>98
'KeyValString = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT; MS Search 4.0 Robot)"
>>99
' SubKeyNameString(3) = ["IE CompList", "IE.HKCUZoneInfo", "IE40.UserAgent"]
は、キー値取得のための各値を定義して、実際に取得したもの。
2016.09に作成したダンプリストのために、現在の内容とは異なっている場合があるから、取得した。
もっとも、Subキーのリストが10000超えた場合もあったのはあせった。
10分ぐらい終了しなかったので、ハングしたのかな、と強制停止の処理を始めたら、終了した。

MSやその他法人が保存しているレジストリーの内容から、ユーザーとしてソフトを動かすために必要な情報を取得できるけれども、
何を使用するか、何を使用しないか、の取捨選択が迫られる。
分量の多さゆえに、このような検索ソフトを作成した。
0102デフォルトの名無しさん
垢版 |
2017/02/27(月) 21:49:00.13ID:GlE4NLGI
Taka06.BAs 内処理として、Disp08.fbp 等のExepath + "\*.fbp"ファイルを読み取って
[File] セクション内 1001=..\Kako02\Mod\Taka01.bas 等の内容を読み取って、

TakaHWND =hWin
TakaDammyReturnCode7 = Taka06_CommonStringSet(TakaHWND)
等の、各モジュールに hWin の内容を通知するルーチンを書き並べたファイル(Taka06HWND.BI)の作成に成功した。
今まで、いちいちどのモジュールが関係しているのかを調べて手作業で行っていたが、
#Include "Taka06HWND.BI"
1文に置き換えることに成功した。
0103デフォルトの名無しさん
垢版 |
2017/03/04(土) 19:20:41.20ID:MZsCuszb
'declare function LCMapStringA (byval Locale as LCID, byval dwMapFlags as DWORD, byval lpSrcStr as LPCSTR, byval cchSrc as long, byval lpDestStr as LPSTR, byval cchDest as long) as long
関係。宣言は
Const MaxStringLen = 1025
Dim dwMapFlags as DWORD
Dim AZstring As ZString * MaxStringLen
Dim BZstring As ZString * MaxStringLen
Dim cchSrc as Long, cchDest as Long
Dim As Long IAA, IBB, SetFigLong()
Dim As BOOLEAN ABool, BBool, DBool
実行部は
AZstring = iAstring
cchSrc = Len(AZstring)
cchDest = MaxStringLen
IAA = LCMapString(LOCALE_USER_DEFAULT, dwMapFlags, @AZstring, cchSrc, @BZstring, cchDest)
TakaComvString = BZstring
http://msdn.microsoft.com/ja-jp/library/cc448052.aspx の日本語文が難解だから気を付けてほしい。
0104デフォルトの名無しさん
垢版 |
2017/03/04(土) 19:23:36.71ID:MZsCuszb
declare function CompareString alias "CompareStringA"(byval Locale as LCID, byval dwCmpFlags as DWORD, byval lpString1 as PCNZCH, byval cchCount1 as long, byval lpString2 as PCNZCH, byval cchCount2 as long) as long
関係。宣言は、
Const MaxStringLen = 1025
Const MaxStringLenN1 = MaxStringLen - 1
Dim dwCmpFlags as DWORD
Dim AZstring As ZString * MaxStringLen
Dim BZstring As ZString * MaxStringLen
Dim As Long IAA, IBB
実行部は
IAA = CompareString(LOCALE_USER_DEFAULT, dwCmpFlags, @AZstring, -1,@BZstring, -1)
参考は
http://www.s34.co.jp/cpptechdoc/article/comparestring/

以上2つともコンパイラーむが通っただけ。
中身のチェックなどはしていない。
0105デフォルトの名無しさん
垢版 |
2017/03/05(日) 10:25:39.08ID:rfEgkW/x
DBSC、QBでは、INT21 - 53(非公開、MS-DOSの東アジア向けバージョンにのみ搭載)だったかな、で取得できる ASCZZ文字列の取得方法がわかった。
宣言は
Dim CodePageInfo1 as _cpinfo
Dim CodePageInfo2 as _cpinfoexA
Dim dwFlags as DWORD
Dim Astring As String, Bstring As String
Dim As Long IAA
実行部は
MSReturnCode = GetCPInfo(CP_ACP, @CodePageInfo1)
MSReturnCode = GetCPInfo(CP_MACCP, @CodePageInfo1)
MSReturnCode=GetCPInfo(CP_OEMCP,@CodePageInfo1)
MSReturnCode = GetCPInfoEx(CP_ACP, dwFlags, @CodePageInfo2)
MSReturnCode=GetCPInfoEx(CP_MACCP,dwFlags,@CodePageInfo2)
MSReturnCode = GetCPInfoEx(CP_OEMCP, dwFlags, @CodePageInfo2)
参考は
'https://msdn.microsoft.com/ja-jp/library/cc422078.aspx
'declare function GetCPInfo(byval CodePage as UINT, byval lpCPInfo as LPCPINFO) as WINBOOL
'https://msdn.microsoft.com/ja-jp/library/cc422080.aspx
'declare function GetCPInfoExA(byval CodePage as UINT, byval dwFlags as DWORD, byval lpCPInfoEx as LPCPINFOEXA) as WINBOOL
0107デフォルトの名無しさん
垢版 |
2017/03/05(日) 10:44:56.24ID:rfEgkW/x
https://ja.wikipedia.org/wiki/MS-DOS
に「アジアバージョン」とかかれているのがDBCSをさぽとーしたMS-DOS。
英語版を無理に使うと日本語ファイる名がディレクトリーになったりして、散々な目にあった方々がいた。
0108デフォルトの名無しさん
垢版 |
2017/03/08(水) 20:31:55.47ID:Wan8ns7S
ついに、サブルーチンの移植総数が1000個を超えた。
大域サブルーチン 901個、局所サブルーチン 99個、作成中 3個。
Overload も全体で114個、27種類のルーチン名でまとめた。
引数の型違いのルーチンが増えれば、より多くなるだろう。

http://makoto-watanabe.main.jp/freebasic/CatPgString.html
で、KLEN、KMIDの2つしかないので、いろいろ作成中。
Dim CodePage as UINT
Dim As Long IAA, IBB, InALong
Dim TestChar as UBYTE

'https://msdn.microsoft.com/ja-jp/library/cc448045.aspx
'declare function IsDBCSLeadByte(byval TestChar as UBYTE) as WINBOOL
'https://msdn.microsoft.com/ja-jp/library/cc448047.aspx
'declare function IsDBCSLeadByteEx(byval CodePage as UINT, byval TestChar as UBYTE) as WINBOOL

For IAA = 1 To InALong
TestChar = asc(Mid$(InAstring, IAA, 1))
IBB = IsDBCSLeadByte(TestChar)
If (IBB = 0) Then
Else
EndIf
Next IAA
又は
IBB = IsDBCSLeadByteEx(CodePage, TestChar)
で振り回して、先頭から処理していけば比較的簡単に作れるだろう。
0109デフォルトの名無しさん
垢版 |
2017/03/08(水) 20:35:59.45ID:Wan8ns7S
ただし、Right$()は
If (IBB = 0) Then
StateLong(IAA) = 0
Else
StateLong(IAA) = 1
IAA = IAA + 1
StateLong(IAA) = 2
EndIf
と、SBCS(0)かDBCS(1文字目が1, 2文字目が2)と記録して
後ろから文字数を数える必要がある。
Instr() は手を付けていない。
ASC1文字検索の時だけDBCS2文字目の場合にはねるだけだから、比較的簡単に作れると思う。
0110デフォルトの名無しさん
垢版 |
2017/03/11(土) 09:33:14.20ID:U4jxaOIA
http://makoto-watanabe.main.jp/program.html#binary_editor
に紹介のあった Stirling の実行形式のパスを取得するルーチンを作成した。
宣言は
Dim RootKey as HKEY
Dim As string SubKeyString, kNameString
Dim As string AAString, BBString, CCString, FileString
Dim FileTypeString as String
TakaDammyReturnCode = RegistryRead01(RootKey, SubKeyString, kNameString, AAString)
でレジストリーを読み取って、管理ファイル名(たぶん)から実行形式に変換
TakaDammyReturnCode = FileTypeCat(AAString, FileTypeString, 0): 'AAString から識別子(.以降)を取り除く
StirlingPathString = AAString + ".exe"
'使用例
'BinLineString = StirlingPathString(0&)
'If (Len(BinLineString) > 0&) Then TakaDammyReturnCode = Exec(BinLineString, FileString): '同期する
関数名などは省略。
0111デフォルトの名無しさん
垢版 |
2017/03/11(土) 09:55:02.25ID:U4jxaOIA
Function RegistryRead01() は、旧 Fun GetRkey01() の名称を書き換えたもの。
旧 Fun GetRkey01()は、前スレを探してくれ。

>>109 つづき。
Instr() を作ろうとして、整理していったらば、
StateLong() 配列の解釈に間違いがあったことまでつかんだ。

気がめいったので一時中止。Instr( start, str, substring )
のstartの値、strや substringの長さより、場合分けが必要で
混乱に混乱を重ねて、一括ダンプルーチンを2回作り直した時点で、気がめいった。
StateLong() 配列作成の時点で場合分け用値を定義するか、返した値から定義するか、で迷っている。

ここにMID$()関数の問題が入った。
Mid$(A$, 10, -5)なんて使い方用のルーチンもあったのよ。
これは、N88を使いだす前、A$が255文字制限のあったころ、ペット用Basicを使っていたころの名残。
忘れていたわ、こんなルーチンを作っていたなんて。
0112デフォルトの名無しさん
垢版 |
2017/03/12(日) 18:13:41.20ID:a1qa7agM
以前書いた、BEEP系の内容の続き。
Win系関係ルーチンで発見できたものを記載する。
'declare 文は、C:\tool\FreeBASIC 内 *.BIファイルを検索してくれ。
大域宣言
#Include Once "win/mmsystem.bi"
Dim Shared MSerrorCodeMM as MMRESULT : 'MS音声処理関係処理のリターンコード

'declare function Beep_ alias "Beep"(byval dwFreq as DWORD, byval dwDuration as DWORD) as WINBOOL
MSReturnCode = Beep_(Frequency, BeepTime) : '命令語
'https://msdn.microsoft.com/ja-jp/library/cc428923.aspx

'https://msdn.microsoft.com/ja-jp/library/cc429002.aspx
'Declare function MessageBeep(byval uType as UINT) as WINBOOL
MSReturnCode = MessageBeep(-1)
MSReturnCode =MessageBeep(MB_ICONASTERISK)
MSReturnCode = MessageBeep(MB_ICONEXCLAMATION)
MSReturnCode= MessageBeep(MB_ICONHAND)
MSReturnCode = MessageBeep(MB_ICONQUESTION)
MSReturnCode =MessageBeep(MB_OK)
0113デフォルトの名無しさん
垢版 |
2017/03/12(日) 18:17:37.48ID:a1qa7agM
'http://park7.wakwak.com/~efc21/cgi-bin/exqalounge.cgi?print+200707/07070177.txt
にあったMIDI利用 BEEP は何とか成功した。

Dim lngmidHndVal As HMIDIOUT__
Dim lngmidHndPtr As HMIDIOUT
Dim lngmidHndPtrPtr As LPHMIDIOUT
で宣言して、
'declare function midiOutOpen(byval phmo as LPHMIDIOUT, byval uDeviceID as UINT, byval dwCallback as DWORD_PTR, byval dwInstance as DWORD_PTR, byval fdwOpen as DWORD) as MMRESULT
MSerrorCodeMM = midiOutOpen(@lngmidHndPtr, MIDI_MAPPER, 0, 0, CALLBACK_NULL)
If (MSerrorCodeMM = MMSYSERR_NOERROR) Then BeepMidiOut (lngmidHndPtr, MdiMsg)
Sleep mTime
midiOutClose (lngmidHndPtr)
とならす。

Private Function BeepMidiOut(lngmidHndPtr As HMIDIOUT, DataString As String) As Wata
Dim MLMsg() As Byte
Dim As Long IAA, IBB
Dim lpMidiOutHdr As MIDIHDR
と、宣言して、
ReDim MLMsg(0& To Len(DataString) \ 2& - 1&)
For IAA = 1& To Len(DataString) Step 2&
MLMsg((IAA - 1&) \ 2&) = Val("&H" & Mid(DataString, IAA, 2&))
Next
lpMidiOutHdr.lpData = VarPtr(MLMsg(0))
lpMidiOutHdr.dwBufferLength = UBound(MLMsg) + 1&
lpMidiOutHdr.dwFlags = 0&
'declare function midiOutPrepareHeader(byval hmo as HMIDIOUT, byval pmh as LPMIDIHDR, byval cbmh as UINT) as MMRESULT
MSerrorCodeMM = midiOutPrepareHeader (lngmidHndPtr, @lpMidiOutHdr, Len(lpMidiOutHdr))
'declare function midiOutLongMsg(byval hmo as HMIDIOUT, byval pmh as LPMIDIHDR, byval cbmh as UINT) as MMRESULT
MSerrorCodeMM = midiOutLongMsg (lngmidHndPtr, @lpMidiOutHdr, Len(lpMidiOutHdr))
と鳴らす。
0114デフォルトの名無しさん
垢版 |
2017/03/12(日) 18:21:32.40ID:a1qa7agM
音が聞こえなかったのは、Sleep mTime の解釈が原因だと思う。
BeepMidi("02", "60", 2000)
'BeepMidi("57", "60", 2000) 'C7:2093Hz
のように、演奏時間を2000としたら、何秒か聞こえた。
遅延が、2-3秒ぐらいあり、その期間無答となるので、ゲームサウンドには使えない。
0115デフォルトの名無しさん
垢版 |
2017/03/12(日) 19:21:01.74ID:a1qa7agM
さっぱりわからんけど
https://blogs.windows.com/buildingapps/2016/09/21/midi-enhancements-in-windows-10/#HWygA7trSYw9sboJ.97
なんてものを見つけた。
Windows 10でMIDIを強化するというが、2秒ぐらいの遅延が発生していることからみれば
対応を取らなければ、MIDI関係ルーチンが使い物にならないわけで
主要用途である、ゲームのバックグラウンドサウンドにうまく適応で切るような、低負荷ルーチンの存在が必要となってくる。
Win 10では、1/4を超えるCPU占有をTSSで他のタスクに割り振るために認めていない。
より負荷を軽くすることが要求される。
しかし、負荷を軽くする内容については記載がない。
0116デフォルトの名無しさん
垢版 |
2017/03/12(日) 19:38:38.32ID:a1qa7agM
いくらやっても見つからないと思ったらば、こんなの見つけた。
https://www.slideshare.net/garicchi/windows10api
37. バックグラウンドタスク
38. BackgroundTask • UWPは基本的にアプリを閉じるとタスクを実行できなくなる • BackgroundTaskに登録しておくとTriggerが発動したときに別
のプロセスとして処理を実行できる App System System Trigger BackgroundTask 別プロセス BackgroundTask登録
39. Background Task Triggerの例 • Time Trigger • 一定時間でTaskを実行 • 最短15分間隔 • System Trigger • システムのあらゆるイベント時にTask実行
• 例 Internet Available , Power State Changed • Push Notification Trigger • プッシュ通知が来た時にTask実行

MIDI 再生専用のタスクを作って、何かしかの指示を送って実行、
という処理が必要なのかな?。
0117デフォルトの名無しさん
垢版 |
2017/03/13(月) 22:50:24.29ID:71lamdyx
http://www.utp.or.jp/bd/978-4-13-064067-1.html
機会があったらば読んでほしいのだけれども。

細かい計算や理論は除外して、
SALSの運用の話を見てほしい。

全部のソースリストが記載されているものがあって、
記載内容を修正した後でソースリスト(2万枚のパンチカード?)を修正する
という旨の内容が書いてあったはず。
いつ、どのような修正をしたのか、修正の前後の内容を保存している
ということをしないと、障害の巣窟になってしまう、なんて内容が書いてあったはず。

これは、デカコンを使っていたころ読んだ本なので、手元にない。版元では品切 の模様。
どこが、どのようにおかしいから、どのように変更した、
ことを記載しておくこと。
現実としては、作業記録として専用に作るのは面倒だから、
ライブを定期的に、あるいは大規模な修正を行う前に、一括して圧縮保存。
修正作業に入って、修正した日時と修正の原因をコメント行としてソースに残しておく、
ということで、済ましている。

FreeBasicの癖がよくわからないので、>>111 の様な事をやっていて、
本格的な移植作業には入っていない。
ライブの移植が終わるころには、癖がつかめてくるのではないかと思われる。
0118デフォルトの名無しさん
垢版 |
2017/03/13(月) 22:59:35.57ID:71lamdyx
MIDIファイル再生に関して、こんなものを見つけた。
http://officetanaka.net/excel/vba/tips/tips22.htm
以下のファイルが関係している。
C:\tool\FreeBASIC\inc\win\mmsystem.bi
C:\tool\FreeBASIC\inc\win\ddk\mmddk.bi
ここまでしかやっていない。
0119デフォルトの名無しさん
垢版 |
2017/03/13(月) 23:49:42.95ID:71lamdyx
>>114 こんなの見つけたので知らせておく
http://www.cactussoft.co.jp/Sarbo/divMIDISeqLongMsg.html
そのためmidiOutLongMsg()関数は、非同期式で動作する仕様になっています。
非同期式とは、関数が実行された段階でデバイスドライバーは、
「はい、ロングメッセージの送信ですね、受け付けました。」と言うだけで制御を戻します。

と待ち時間に関係なしに制御が戻って、勝手に演奏してくれないと、パックグラウンド゜サウンドに使えない。

ズンチャカやっていて、それ以外の処理系が止まってしまうのは、使えない。
0121デフォルトの名無しさん
垢版 |
2017/03/14(火) 22:03:19.95ID:1/oLMu3p
Case MM_MCINOTIFY
'「MM_MCINOTIFY」定数を使うには 要 #Include Once "win/mmsystem.bi"
Astring = "MM_MCINOTIFY "+ Hex$(wParam) + " " + Hex$(lParam)
TakaDammyReturnCode = SoundFilePlay(10, Astring)
buff = Astring
SetDlgItemText(hWin, IDC_STC1, @buff)
'wParam = (WPARAM) wFlags
'lParam = (LONG) lDevID
0122デフォルトの名無しさん
垢版 |
2017/03/14(火) 22:06:03.27ID:1/oLMu3p
あと
CmdZString ="Open " & SoundFile+" notify"
MSerrorCodeMI= mciSendString(CmdZString, @CmdRetZString, SizeOf(CmdRetZString), TakaHWND)
buff ="Openを開始します"
SetDlgItemText(hWin, IDC_STC1, @buff)
Case IDC_BTN3
CmdZString= "Play "&SoundFile + " notify"
MSerrorCodeMI =mciSendString(CmdZString,@CmdRetZString, SizeOf(CmdRetZString), TakaHWND)
buff= "Playを開始します"
SetDlgItemText(hWin, IDC_STC1, @buff)
Case IDC_BTN4
CmdZString ="Close " & SoundFile+" notify"
MSerrorCodeMI= mciSendString(CmdZString, @CmdRetZString,SizeOf(CmdRetZString), TakaHWND)
buff ="Closeを開始します"
SetDlgItemText(hWin, IDC_STC1, @buff)
0123デフォルトの名無しさん
垢版 |
2017/04/09(日) 21:36:39.17ID:LdLCQwyT
Test
0124デフォルトの名無しさん
垢版 |
2017/04/09(日) 21:43:21.61ID:LdLCQwyT
>>122 のあと、マンゴーがなにんとかで、かけなくなって放置。
気が付いた点で関係情報を
外部タスクの同期起動は、Shell 等がある。
保守関係で、被同期にしたいので探して見つかったのが
'declare function WinExec(byval lpCmdLine as LPCSTR, byval uCmdShow as UINT) as UINT
'MSReturnCodeUINT = WinExec(byval "notepad", SW_SHOW)
とか
MSReturnCodeUINT = WinExec(byval "notepad "+OutFile, SW_SHOW)
これは、MSが切り替えを予定している。それで
'declare function CreateProcessA(byval lpApplicationName as LPCSTR, byval lpCommandLine as LPSTR,
byval lpProcessAttributes as LPSECURITY_ATTRIBUTES, byval lpThreadAttributes as LPSECURITY_ATTRIBUTES,
byval bInheritHandles as WINBOOL, byval dwCreationFlags as DWORD,
byval lpEnvironment as LPVOID, byval lpCurrentDirectory as LPCSTR, byval lpStartupInfo as LPSTARTUPINFOA,
byval lpProcessInformation as LPPROCESS_INFORMATION) as WINBOOL
Dim pi As _PROCESS_INFORMATION
Dim PiPtr as LPPROCESS_INFORMATION
dim si as _STARTUPINFOA
Dim SiPtr as LPSTARTUPINFOA
Dim As Zstring * 256 szCmd = "notepad "+OutFile

PiPtr = @pi
SiPtr = @si
memset(@si, 0, sizeof(STARTUPINFO))
memset(@pi, 0, sizeof(PROCESS_INFORMATION))
si.cb = sizeof(STARTUPINFO)
' 1 2 3 4 5 6 7 8 9 10
MSReturnCode = CreateProcess(NULL, szCmd, NULL, NULL, FALSE, NORMAL_PRIORITY_CLASS, NULL, NULL, @Si, @pi)
0125デフォルトの名無しさん
垢版 |
2017/04/09(日) 21:48:26.55ID:LdLCQwyT
タイマー割り込み処理。
Case IDC_BTN1
buff = "IDC_BTN1を開始します"
'declare function SetTimer(byval hWnd as HWND, byval nIDEvent as UINT_PTR, byval uElapse as UINT, byval lpTimerFunc as TIMERPROC) as UINT_PTR
SetTimer(hwnd, 1, 2000, NULL)
SetDlgItemText(hWin, IDC_STC1, @buff)

で起動して
case WM_TIMER
'
buff = "WM_TIMER が発生しました"
SetDlgItemText(hWin, IDC_STC1, @buff)
Case WM_SIZE
と「WM_TIMER」事象発生を受けて、かン系ルーチンを起動する
0126デフォルトの名無しさん
垢版 |
2017/04/09(日) 22:09:11.11ID:LdLCQwyT
V.B.用に作ったタートル関係、FreeBasicでは関係命令が存在するだが、
変な拡張をしたがために、廃止できない状態に。
うまく動かないと思ったらば、ByRef, ByValの関係で、出力値に常に0が定義されていた。

(なんたら)=(かんたら)のなんたら部のみを検索するルーチンを作って、
Function文から引数名を引き抜くルーチンを作って、比較。
1ファイル平均3引数程度、ByRefをしなければならない場所がByValになっていた。
短期即興のルーチンだから解釈できない引数が800近くある。
ルーチン数でも同じくらいだから、引数の関係した未発見のエラーが多いと思われる。
タートル関係のルーチンが増えて、現在1170ルーチンのライブラリーとなっている。
0127デフォルトの名無しさん
垢版 |
2017/04/09(日) 22:26:03.33ID:LdLCQwyT
ファミコン等、かなり古いゲームでは8*8文字とか使っている。
それ前だと、ニキシー管 https://ja.wikipedia.org/wiki/%E3%83%8B%E3%82%AD%E3%82%B7%E3%83%BC%E7%AE%A1
を使ったスロットマシーンとかもある。

V.B.でこれを再現しようとした名残で、7セグとか14セグ、16セクとか
https://ja.wikipedia.org/wiki/7%E3%82%BB%E3%82%B0%E3%83%A1%E3%83%B3%E3%83%88%E3%83%87%E3%82%A3%E3%82%B9%E3%83%97%E3%83%AC%E3%82%A4
の文字表示ルーチンがある。
結果として、V.B.用のタートルが捨てられない。
0128デフォルトの名無しさん
垢版 |
2017/04/13(木) 21:48:58.87ID:CzF9QVAq
ByRef, ByVal 接頭語に関して。
サブルーチン内で定義する方法をLet文、具体的には「=」記号のみに限定する
という方法を選択して、
引数の変数を示す語をInstrで探して、
前が数字とアルファベット以外・又は文頭、後ろが数字とアルファベット以外、の場合に、変数を参照していると解釈する。
Open、For、Dim、ReDim、Select Case、IF、DO、LOOP、WHILE、Untilの場合には専用にルーチンで語の一致をみて、参照する場合と決定
IF THEN ELSE 文は、IF - Then 間、THen-Else間、ELSE移行の3文に分割
変数の前の文字を 「# : , ( 算術演算子」の場合に分けて
変数の後ろの文字を 「: , ) 算術演算子」の場合に分けて
「,」や「()」の場合には、前後の()を探して、配列名か関数名を特定。Declear文に記載がある場合に限って関数と解釈、ない場合が配列と解釈。
関数の場合には、自己の検査結果より引数が定義にしているか参照しているを調べる。配列名の場合には参照すると決定(MSやUnix系関数は判断できない)。
算術演算子の場合には参照と決定。
前に「#」があるばあいには、参照と決定。
前に「=」があるばあいには、参照と決定。
後ろに「=」があるばあいには、定義と決定。
多文字演算子として、MOD 演算子は + に書き換えで処理。

までやって、100位解釈できない引数があるけど、なんとかそれらしきものができた。
あとちょっとやれば、ByRef ByVal ガ原因の混乱は終焉すると思う。
0129デフォルトの名無しさん
垢版 |
2017/04/15(土) 11:39:21.57ID:e+ro1QoX
>>122 のあとのマンゴー関係で書けなかった内容。
画面中にある表示枠情報。
Dim CmWndpl As WINDOWPLACEMENT
CmWndpl.length = sizeof(CmWndpl): 'MS指示、参照前に定義のこと
MSReturnCode = GetWindowPlacement(hWnd, @CmWndpl)
で取得、
MSReturnCode = SetWindowPlacement(hWnd, @CmWndpl)
で復元。

'使用TVの物理サイズの取得
Dim R As RECT
Dim as HWND hWnd
hWnd = GetDesktopWindow()
MSReturnCode = GetWindowRect(hWnd, @R): 'スクリーン座標の取得

'タスクバーの位置と大きさを返す
Dim TaskBerInfo As _AppBarData
'(大域) Dim MSReturnCodeUintPtr as UINT_PTR
ZeroMemory(@TaskBerInfo, sizeof(TaskBerInfo)) : '(MS指定) 「TaskBerInfo」領域内を0で塗りつぶす
TaskBerInfo.cbSize = sizeof(TaskBerInfo): '(MS指定) 初期化、領域の大きさを定義
'declare function SHAppBarMessage(byval dwMessage as DWORD, byval pData as PAPPBARDATA) as UINT_PTR
MSReturnCodeUintPtr = SHAppBarMessage(ABM_GETTASKBARPOS, @TaskBerInfo)
リターンコードが「UINT_PTR」という使用頻度の低い型を使っていることに注意。
0130デフォルトの名無しさん
垢版 |
2017/04/15(土) 11:46:28.47ID:e+ro1QoX
'システム枠の幅と高さの取得
'declare function GetSystemMetrics(byval nIndex as long) as long
Select Case ActionType
Case SM_CXSCREEN, SM_CYSCREEN
'0, 1 'プライマリモニタの画面全体の幅と高さを取得します。
WideLong = GetSystemMetrics(SM_CXSCREEN)
HightLong = GetSystemMetrics(SM_CYSCREEN)
Case SM_CXVSCROLL, SM_CYHSCROLL
'2, 3 垂直スクロールバーの幅、または垂直スクロールバーの矢印の高さをピクセル単位で取得します。
WideLong = GetSystemMetrics(SM_CXVSCROLL)
HightLong = GetSystemMetrics(SM_CYHSCROLL)
'const SM_CYCAPTION = 4 ''通常のタイトルバーの高さをピクセル単位で取得します。
Case SM_CXBORDER, SM_CYBORDER
'5, 6 立体効果のないウィンドウの境界の幅と高さを取得します。
WideLong = GetSystemMetrics(SM_CXBORDER)
HightLong = GetSystemMetrics(SM_CYBORDER)
Case SM_CXDLGFRAME, SM_CYDLGFRAME
'7,8 'タイトルバーがあり、サイズが変更できないウィンドウの周囲を囲む枠の幅と高さをピクセル単位で取得します。
WideLong = GetSystemMetrics(SM_CXDLGFRAME)
HightLong = GetSystemMetrics(SM_CYDLGFRAME)
以下略。「GetSystemMetrics」関係がやたら沢山あって下手に書くとマンゴーに引っかかりそうなので一部分だけ。
Case SM_CXVIRTUALSCREEN, SM_CYVIRTUALSCREEN
'78, 79 仮想画面の幅と高さをピクセル単位で取得します。
WideLong = GetSystemMetrics(SM_CXVIRTUALSCREEN)
HightLong = GetSystemMetrics(SM_CYVIRTUALSCREEN)
と、40組ぐらいある。
'const SM_CXFOCUSBORDER = 83
から
'const SM_CMETRICS = 97
まで、Win系BIファイル('C:\tool\FreeBASIC\inc\win\winbase.bi)には記載があるが、内容が検索では見つけられなかった定数がある。
0131デフォルトの名無しさん
垢版 |
2017/04/15(土) 11:51:10.66ID:e+ro1QoX
'表示枠全体, 表示枠使用可能範囲、最大表示可能枠の取得
Dim MainWaku as tagRECT
Case 1
'declare function GetWindowRect(byval hWnd as HWND, byval lpRect as LPRECT) as WINBOOL
MSReturnCode = GetWindowRect(InhWin, @MainWaku) 'InhWinの左上端と右下端の座標をスクリーン座標で取得します。
Case 2
'declare function GetClientRect(byval hWnd as HWND, byval lpRect as LPRECT) as WINBOOL
MSReturnCode = GetClientRect(InhWin, @MainWaku) 'InhWinの表示枠内、ユーサー領域の左上端と右下端の座標をスクリーン座標で取得します。
Case 3
'declare function GetClipCursor(byval lpRect as LPRECT) as WINBOOL
MSReturnCode = GetClipCursor(@MainWaku) 'マウスカーソルの移動可能な範囲に相当するスクリーン座標を取得します(最大表示範囲)。
Case 4
'http://liweijing.blogspot.jp/2007/03/blog-post.html
'declare function SystemParametersInfoA(byval uiAction as UINT, byval uiParam as UINT, byval pvParam as PVOID, byval fWinIni as UINT) as WINBOOL
MSReturnCode = SystemParametersInfo(SPI_GETWORKAREA, 0, @MainWaku, 0) 'タスクバーの大きさをのぞいた画面の大きさ
0132デフォルトの名無しさん
垢版 |
2017/04/15(土) 11:54:37.99ID:e+ro1QoX
'表示枠全体, 表示枠使用可能範囲取得
Dim hBtn As HWND
Dim MainWaku as tagRECT
Dim PointXY as tagPOINT
hBtn = GetDlgItem(InhWin, IDnoGRALong): '表示枠内部品のハンドル(枠番号)を取得, hBtn=0でエラー
Select Case ActionType
Case 1, 11
MSReturnCode = GetWindowRect(hBtn, @MainWaku) 'hBtnの表示枠内部品の、左上端と右下端の座標を表示枠座標で取得します。
Case 2, 12
MSReturnCode = GetClientRect(hBtn, @MainWaku) 'hBtnの表示枠内部品の、左上端(0,0)と右下端の座標を取得します。
0133デフォルトの名無しさん
垢版 |
2017/04/15(土) 11:58:30.77ID:e+ro1QoX
'スクリーン座標 → ユーザー座標に換算
Dim as tagPOINT PointXY1, PointXY2
PointXY1.X = InWaku.Left
PointXY1.Y = InWaku.Top
IF (ActionType = 1) Then
MSReturnCode = ScreenToClient(InhWin, @PointXY1)
Else
MSReturnCode = ClientToScreen(InhWin, @PointXY1)
End If
IF (MSReturnCode = 0) Then IError = 1
PointXY2.X = InWaku.Right
PointXY2.Y = InWaku.Bottom
IF (ActionType = 1) Then
MSReturnCode = ScreenToClient(InhWin, @PointXY2)
Else
MSReturnCode = ClientToScreen(InhWin, @PointXY2)
End If
IF (MSReturnCode = 0) Then IError = 1
IF (Ierror = 0) Then
InWaku.Left = PointXY1.X
InWaku.Top = PointXY1.Y
InWaku.Right = PointXY2.X
InWaku.Bottom = PointXY2.Y
Else
'エラー
End If
てな感じ。
0134デフォルトの名無しさん
垢版 |
2017/04/15(土) 12:03:35.44ID:e+ro1QoX
表示枠や表示部品移動、大きさの変更について、
MSReturnCode = MoveWindow(hBtn, PointXY.X, PointXY.Y, WideLong, HightLong, True): '個別表示物の枠の寸法を定義, 再作画を指示
MSReturnCode = SetWindowPos(InhWin, HWND_TOP, 0, 0, new_width, new_height, SWP_NOMOVE)
MSReturnCode = SetWindowPos(hBtn, NULL, 0, 0, new_width, new_height, uFlags)
MSReturnCode = GetWindowRect(hBtn, @rw)
MSReturnCode = ScreenToClient(InhWin, @PointXY)
MSReturnCode = MoveWindow(hBtn, PointXY.X, PointXY.Y, new_width, new_height, True): '個別表示物の枠の寸法を定義, 再作画を指示
MSReturnCode = SetWindowPos(InhWin, HWND_TOP, LeftLong, TopLong, 0, 0, SWP_NOSIZE)
が関係しているらしいのだけれども、現在混乱して、作成中止中。
0137デフォルトの名無しさん
垢版 |
2017/05/05(金) 06:45:28.53ID:tmTYNlNg
かいとか。連投規制に引っかかった。
0138デフォルトの名無しさん
垢版 |
2017/05/05(金) 07:11:15.97ID:tmTYNlNg
>>128 の内容で一部抜けがある。
Line()等()の後ろに色々指定されている命令の場合、個別に処理して、参照だけで定義されていない
マルチステートにすると解釈が困難になる(:で切って1文1文を検索、表示は切る前の文節)ので、この手の命令を含むマルチステートを禁止した。
SelectCase, Sleep 文も同様な処理が必要になった。
MOD演算子の他にXOR演算子なども書き換えが必要であった。

ByVal, ByRef の間違いが1ファイルに2-3か所ぐらいあった。
引数として存在する物の使われていない変数が結構ある。これは、Function文として()がないと解釈できないので、無意味な引数をつけている。
これがエラーになるので、Type YearnInteger As Integer とYearn型変数を用意して検索の対象から外した。

Astring = ComDeclareListDir2 + "*.txt"
IF (dir$(Astring) <> "" ) then Kill Astring
が動かないみたい。Kill文に*?を使った場合にエラーになるみたい。
対応ルーチン作成中。

日曜プログラマーの場合には、多少実行効率が悪くても、多少処理が遅くても、
ソフト作製時間が少なくて済むように、一番手間のかかる、障害発見時間を短くて済むようにすることが必要。
0139デフォルトの名無しさん
垢版 |
2017/05/06(土) 16:45:07.39ID:Xeh+WPsq
クロスリファレンス表
https://search.yahoo.co.jp/search?p=%E5%A4%89%E6%95%B0%E5%90%8D+%E7%9B%B8%E4%BA%92%E5%8F%82%E7%85%A7%E8%A1%A8%E3%80%80%EF%BC%A2%EF%BD%81%EF%BD%93%EF%BD%89%EF%BD%83&;
aq=-1&oq=&ai=zigtrn1cQYWrys51a_UUkA&ts=3634&ei=UTF-8&fr=top_ga1_sa&x=wrt
の作成ソフトをしらないか。
自作ソフトではかなり解釈ができない場合がある。
例、For-Next のAs 句

自作ソフトがわかりやすいように、文法を制限することはたやすい。
しかし、過去スレを見ればわかる通り、この手の制限をわかりずらいとする人がいる。

日曜プログラマーにとっては、
自分の描いたソフトには必ず障害が発生する、と信じて例外処理ルーチンを付すこと
は、その後の保守の簡便化に関係する。

しかし、簡便化ルーチンを否定する人は多い。
自前のルーチンで解釈が困難で、「難解なルーチン」となる部分を解釈してくれるもの
クロスリファレンス表作成ソフトがあるものと信じて、ここに問い合わせる。
0140デフォルトの名無しさん
垢版 |
2017/05/09(火) 19:35:55.11ID:YDoq9mLA
ファイル名関係処理でDBCS関連がらみの処理をどうしようか、
と迷っていたら、ファイル名関係のシステムコール(スーパーバイザ参照)ルーチンを見つけた。
細かいことは C:\tool\FreeBASIC\inc\win\shlwapi.BI を見てくれ。
「declare function Path」で検索すると、主要なルーチン名を見つけることができる。
一部 declare sub Pathなんたら()があるから注意してくれ。
「Pathなんたら()」と記載しないと参照できない。
0141デフォルトの名無しさん
垢版 |
2017/05/13(土) 22:52:55.55ID:6qsyWLV0
http://www.dotup.org/uploda/www.dotup.org1247922.zip.html
http://www.dotup.org/uploda/www.dotup.org1247923.zip.html

>>140 関係。動作試験した内容。
使いたい人がいたら、適当に使って。
ネットワーク関係のシステムコールが見つかったので整理中。
ローカルでの運用が主体なので、MSネットワーク関係が出てきて混乱している。
V.B.を購入した2000年頃の内容では、MSネットワークがウイルスソフトにやられることが多いので、MSネットワークは使用しないように、というウイルス対応が多かった。
だから、関係ルーチンを使わないようにしていた。だから、内容が理解できない。

C:\tool\FreeBASIC\inc\win\shlwapi.bi の内容は検索してみればわかる通り、個人サイトでは2010年頃に公開されている。
だから、かなり出遅れた内容となる。
'' MS指示 PathAddExtension() → PathCchAddExtension() を使え
なんて旨の内容もある。MSが指定したルーチン名はC:\tool\FreeBASIC\以下の*.BIファイルには見つからなかった。
近い将来、サポートされるものと思う。
0142デフォルトの名無しさん
垢版 |
2017/05/14(日) 11:53:59.80ID:J0U25/Ze
>>140 つづき。
Astring = "*.Txt": Kill Astring
がうまく動作しなくてはじめたこの処理だけど、こんなの見つけてしまった。
http://www.all.undo.jp/asr/Ver7/11.html
>有用性の高いWindows APIの動作が変わってる事だと思います。
>具体的にはPathMatchSpec()というAPIです。
>このAPIはWindows 8正式版の頃から挙動が怪しくなりまして、取りこぼしやら誤ヒットやらと、落ちるわけじゃないんですが比較の結果が正しくない文字が多数発生してました。
ということで、>>141の内容で打ち切って、自前ルーチンの作成が必要であるということになってしまった。
>Windows Vista以降であればPathMatchSpecEx()というAPIが別で存在している
PathMatchSpecEX()があるらしいのだが、FreeBasic ではサポートされていない。
>FindFirst系のAPIだとワイルドカードの組み合わせによって
は、皆さんご存知ですよね。Win 95頃長いファイル名がサポートされて、別名として短いファイル名が用意された。
別名、つまり、8.3形式のファイル名では重複するときに末尾2文字以上を(チルダ)(数字)に置き換える。
だから、おかしなことになりやすい。*で拾って、個別に比較して、処理するということが必要になってくる。
末端ユーザー(オペレーター)に対して、チルダを使うな、と指示して、チルダを使っているファイルをユーザーレベル(プログラム仕様書)で排除すれば済むのだけれど。
0143デフォルトの名無しさん
垢版 |
2017/05/17(水) 20:43:36.59ID:5N4X+pOX
>>141 のつづき。
http://www.dotup.org/uploda/www.dotup.org1251962.zip.html
http://www.dotup.org/uploda/www.dotup.org1251960.zip.html

>>140 関係。動作試験した内容。
使いたい人がいたら、適当に使って。
ネットワーク関係と、表示枠関係は動作試験をやっていない。

不審な動作があったので、ついでに記載。
DimChk42で新規にDialogAppAsMainのテンプレートを使って作成。
その後をDimChk42の内容をDimChk42B, DimChk42C, DimChk42Dにコピーして試験を続けた。
DimChk42AはDimChk42の名称を変更したもの。
DimChk42A内 BAKディレクトリーを消そうとしたら消えない。ReadOnlyになっていたので、これを解除して消去した。
そしたら、DimChk42B, DimChk42CのBAKディレクトリーも一緒に消えてしまった。
どこをどうしているのか、わからないけどOS由来の不審な挙動か、FBEが何かやっているのか、わからない。
OS由来の仕様の可能性が高い。
0144デフォルトの名無しさん
垢版 |
2017/05/20(土) 11:06:25.21ID:ZcoJjZsO
以前書いたような気がするのだが、
*.DLL ファイルの使い方が現時点で分からない。
結果として、LZH, ISH等のファイルが使えないでいる。
ISHは手作業でバイナリに戻して、手持ちのライブラリーのBAse64に切り替えるとして
LZH等が使えないでいる。 http://www.madobe.net/archiver/index.html

ZIPが使えるような雰囲気だが、
C:\tool\FreeBASIC\examples\manual\libraries\zip.bas
対応する ZIP.A ファイルなどが見つけられなかった。

今回、BZIP関係が成功したので、記載する。関係ファイルは
http://www.dotup.org/uploda/www.dotup.org1254567.zip.html
参照。
https://sourceforge.net/projects/fbc/files/Older%20versions/0.90.1/Binaries%20-%20Windows/Libraries/
内' FB-win32-bzip2-1.0.6.zip 内 libbz2.a の参照例
'コピー元ファイル C:\tool\FreeBASIC\examples\compression\bz2compress.bas
圧縮しかできない。解凍方不明。

検索資料 http://s-yata.jp/docs/libbzip2/
BZip対応解凍ソフト、CubeICE、http://www.vector.co.jp/soft/winnt/util/se489109.html

2ちゃんねるって、Base64による投稿を認めているのかな?
0145デフォルトの名無しさん
垢版 |
2017/05/20(土) 19:52:51.58ID:ZcoJjZsO
>>144 
使いたい人がいたら、適当に使って。
これ書き忘れた。

BZIPでは複数ファイルの一括圧縮ができないようなので、一括ファイル合併ルーチンを作ろうとして四苦八苦。
Dim FileSizeOver as DWORD
Dim FileSizeOverPtr as LPDWORD
「FileSizeOverPtr = @FileSizeOver」行を入れるのを忘れて
FileSezeGetULongInt = GetFileSize(FileHandle, FileSizeOverPtr)
とやると、ハングするので要注意。
0146デフォルトの名無しさん
垢版 |
2017/05/24(水) 23:48:18.25ID:ATqZKMOK
>>145 つづき。
なんとか、TARファイルもどき(タイムスタンプや属性をMSのデータそのまま複写等)を作るのに成功。
TARのファイル構造
'http://www.redout.net/data/tar.html tar の構造
'http://openlab.ring.gr.jp/tsuneo/soft/tar32_2/tar32_2/sdk/TAR_FMT.TXT TAR32.DLL フォーマット説明ファイル
を眺めて
https://ja.wikipedia.org/wiki/Tar
をみたら、考えることって同じなんだね。
パンチカードを使っていたころのルーチンが生きていたころ、パンチカードノ内容をほぼそのまま保存したUnPACK形式のデータファイルと
1枚のパンチカードの末尾以後の空白を削除したPack形式のデータが存在する。
Packデータを直接読み取れないのでpack形式をUnPack形式に変換して、固定長データとして取りあ使う。
パンチカートをデータファイルに変換し、保存することを目的に作ったのがパンチ等シすテム。
Tarの構造は、パンチラシステムに近い構造だった。
TARを読んでいたら、BZIPのマルチファイル形式も認めているようなのだが、
関係情報を持っている人はいないか。
Unixのソースファイルを読めば書いてあるのだろうが、Unixはデカコンを使うのをやめた年の終わりごろに入った機械なので、まったく中身を見る時間がなかった。
さっぱりわからない。
0147デフォルトの名無しさん
垢版 |
2017/05/25(木) 21:36:48.40ID:wf6/c17h
>>144 つづき。こんなファイルを見つけた。
'C:\tool\FreeBASIC\examples\dll\dylib.bas のコピー
0148デフォルトの名無しさん
垢版 |
2017/05/27(土) 15:33:51.50ID:ZQgU3vIU
>>147 つづき。
なんとか、LZH A とLZH E の2つのコマンドが使えるようになった。
詳細は、
http://www.dotup.org/uploda/www.dotup.org1262265.zip.html
さんしょう。
DLLファイル関係命令は、以下の通り。
http://makoto-watanabe.main.jp/freebasic/PgDylibsymbol.html
http://makoto-watanabe.main.jp/freebasic/PgDylibload.html
http://makoto-watanabe.main.jp/freebasic/PgDylibfree.html
0149デフォルトの名無しさん
垢版 |
2017/05/27(土) 15:49:52.47ID:ZQgU3vIU
>>148 つづき。
また、書くのを忘れた。
使いたい人がいたら、適当に使って。

Dim なんたら as function(こうたら) As なんたら
の使い方を覚えるべく、引数の類似したルーチンを見つけて、使いして、
文法エラーが出ないか、
だけを注意して継ぎ足していった結果が、>>148
したがって、FreeBasic用に1行Type 命令で定義されている変数型名に合わせているのではなく、
DLLファイルの内容に合わせて定義していった。
だから、変な型変換が入っていたりして動かないものも多いと思う。
0150デフォルトの名無しさん
垢版 |
2017/05/28(日) 20:11:33.54ID:RhTBneuP
>>148 つづき。
使いたい人がいたら、適当に使って。
http://www.dotup.org/uploda/www.dotup.org1263729.zip.html
ULH3300.EXE 導入すれば何とかなるだろうけど、最小限の動作試験程度の内容しかいれていない。
コマンド(C:\Program Files\なんたら\COMMAND.TXT)の使い方が結構忘れている。
あるいは、仕様が変更になったのかもしれない。
QBでは、バッチファイル作成ルーチンを作って、子プロセスでバッチファイルを起動していたから、スイッチなどはきれいさっぱり忘れている。
うまく動かない(子ディレクトリーの再帰読み出しと再帰解凍ができない)。
うまく動かない状態で、ArcDll.basには記載されている。

メモリーの内容を使った圧縮解凍(UnlhaExtractMem,UnlhaCompressMem)はコンパイルできなかった。
'ANSI 版とUnicode 版の2種類が存在する場合(AW)があるけど、区別していない。ANSI 版が起動しているはず。
UniCode( As WSTRING) を使っていないから。
今のところDBCSがわからなくて放置しているから、Uni-Codeまで手が回らない。
0151デフォルトの名無しさん
垢版 |
2017/06/02(金) 23:57:18.03ID:fEm5aE5c
マイクロソフトの作成した*.HファイルをFreeBasic用の*.BIファイルに機械変換した
という意味にとれる内容が記載されていたので、ちょっと探してみた。
Converting C Headers with swig
と、SWINGというソフトがある模様。しかし、現時点でDLハすべて失敗している。
https://sourceforge.net/projects/swig/?source=typ_redirect
0152デフォルトの名無しさん
垢版 |
2017/06/04(日) 01:21:58.65ID:YYutyyMm
検索してみたらそれらしきものが有ったけど
日付がかなり古い感じ
https://www.freebasic-portal.de/downloads/kommandozeilentools/swig-fb-wrapper-70.html
自分ではダウンロードもしていないし試していない
このサイトなら大丈夫だと思うけど自己責任で

こういうのも有るみたいよ
https://github.com/dkl/fbfrog
これは素のCだけでC++には対応してないみたい
参考にどうぞ

前にスレでswigの話してる時に揉めてたみたいね・・・
0153デフォルトの名無しさん
垢版 |
2017/06/21(水) 08:52:54.72ID:62o+/t06
test
0154デフォルトの名無しさん
垢版 |
2017/06/21(水) 19:25:35.91ID:62o+/t06
>>152
ドイツのサイトで
https://www.freebasic-portal.de/downloads/kommandozeilentools/h2bi-bas-134.html
を見つけた。現在ドイツ語を解読中。
コマンドラインから実行するように作成された複数のファイルがあるみたい。

swig_fb.exe を実行したら、| More とか >>HelpMess.txt のようなパイプ処理が使えないWin10だった。
現在SWIG Users Manual, E:\BasTool\SwigWinDoc\Manual\Contents.html を解読中
共通部分だけ解読すれば何とかなりそうなので、そんなに時間がかからないと思うけど
LZH A とLZH E の2つのコマンドが使えるから、急く必要性は低い。
0155デフォルトの名無しさん
垢版 |
2017/06/23(金) 20:28:24.97ID:sAip3Otx
以前から何回か書いているように、自己書き換えルーチンが存在する。
TakaDammyReturnCode4 = TakaErrorPointSach(IniNameString, TakaSubRoutineNo)
の行を各サブルーチンに追記するだけなんだけど
Function TakaErrorPointSach(IniNameString As String, TakaSubRoutineNo As Long) As Wata
ルーチン内に
TakaDammyReturnCode4 = TakaErrorPointSach(IniNameString, TakaSubRoutineNo)
行を書き込んでしまったのが自己書き換えルーチン。

コンパイルは正常終了。実行したら、ハングした。
サブルーチンコールに伴うスタック不足のエラーが発生しないで、ハングする。
どのくらい多重参照できるか調べていないが、原因の特定が困難な障害の原因になりうるので、注意してくれ。
0156デフォルトの名無しさん
垢版 |
2017/06/24(土) 20:29:56.29ID:tgLAy7wE
前スレの内容になるが
http://www.hi-ho.ne.jp/makoto_watanabe/FbEdit/tut2.htm#start
で、
#Define Text1 1001
に対して、IMEで日本語を入れると、じばけしてしまう。対応として
CONTROL "",IDC_LST1,"ListBox",0x50310141,3,0,40,12,0x00000200
のようにリストボックスを用意して、
いくつかの候補をINIファイルなどに保存して置き、
選択入力するようにした。
ソフトで行う内容なんて、初期状態はともかくとして、ある程度の期間がたつと同じようなことしかしなくなる。
入力に関して、自由度が低くても、なんとかならないことはない。
INIファイルなどはエディタを使って直接編集する。
エディタの同期起動については、SHELL命令などを参考にしてくれ。
0157デフォルトの名無しさん
垢版 |
2017/06/25(日) 14:13:32.16ID:0Z+EQ6/s
QB時代から使っていた
AString = "D:\TTT\*.*"
IF Dir$(AString) <> "" Then Kill AString
が、FreeBasicではうごかない。ファイルが削除されず残ってしまう。

ByRef ByVal前置句の辞書とか、過去にソースファイルから読み取って、
後で何かの処理に使おうとして保存している情報がある。
INI ファイルでは、32KB, 64KBの壁があり、32/3*2 = 16KBて、1ファイル21KBを超えないように管理する必要がある。
最大容量の2/3を超えないように最初は設計する。2/3を超えるようなことがあったらば設計しなおし、1/2まで減らす。
というのが、学生時代に学んだ在庫管理で、今は
https://www.sist.ac.jp/~suganuma/kougi/other_lecture/SE/stock/stock.htm
な内容がある。日曜プログラマーとしては、簡便に、多少効率が悪くても最適解を使わないで、簡易解を使うことになる。
1ファイルに入りそうもないと思ったらば、
1文字目でアルファベット別の30分割(A-Z、数字)とか
元ファイル別に本来の値を残して、簡易ファイルで検索するとか
の手法を使う。データベースファイルを構築できればよいのだが、今のところ成功していない。

このためだけに、特定のディレクトリーに分割保存したINIファイル一括削除ルーチンを作成した。
使いたい人は使って、何かの参考にしてくれ。ライブの内容は除いてある。
http://www.dotup.org/uploda/www.dotup.org1293573.lzh.html
0158デフォルトの名無しさん
垢版 |
2017/06/28(水) 21:40:33.73ID:KQoqOcRm
'declare function GetFileTime(byval hFile as HANDLE, byval lpCreationTime as LPFILETIME, byval lpLastAccessTime as LPFILETIME, byval lpLastWriteTime as LPFILETIME) as WINBOOL
lngWin32apiResultCode = GetFileTime(lngOpenFileHandle, @udtCreationTime, @udtLastAccessTime, @udtLastWriteTime)
の関係するフゃいるの時刻情報の取得で、
一連の処理に時間がかかる。CreateFile(), GetFileTime(), FileTimeToLocalFileTime(), FileTimeToSystemTime(), CloseHandle()
結果として、処理が終わる前に再度起動する(障害としてもう1回クリックしなおす)。
2度目の時に、訳の分からない動作をする。
重複起動を抑制するルーチンが必要となる。
レスを投稿する


ニューススポーツなんでも実況