ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2018年7月17日(火) 04:53

All times are UTC+09:00




新しいトピックを投稿する  トピックへ返信する  [ 8 件の記事 ] 
作成者 メッセージ
投稿記事Posted: 2005年7月20日(水) 08:44 
オフライン

登録日時: 2005年7月19日(火) 07:02
記事: 183
住所: 宮城県
Ver2,x → Ver3.x へのバージョンアップに伴って消えた
命令語、関数のうち、以下の5つのVer3.xへのエミュレート案です。
  • LineInput #
    SetClipStr
    ClipStr$
    OwnerWnd()
    CmdLine$
クラスが使えるVer4.x用としては、コマンドラインと
クリップボードに関するクラスがすでに投稿されていますが、
まぁこちらは、Ver2.xの表記を好んでいる方向け、ってことで。

Ver3.13 Final Edition で動作確認しています。
Ver3.xのコードはVer4.xへもそのまま流用できるはずですので、
Ver4.xでも動作すると思います。
コード:
'******************************************************
'  Ver2.x記述重視のVer3.x用の関数エミュレート
'
'  【命令語】
'  LINEINPUT filenumber, buf
'  SetClipStr buf
'
'  【関数】
'  ClipStr()   ※クリップボードのテキスト(String型)が返ります。
'  OwnerWnd()  ※プロンプト・ウィンドウのハンドル(Long型)が返ります。
'  CmdLine()   ※コマンドライン引数(String型)が返ります。
'  
'******************************************************

'WsCmdLine()内で利用。
Declare Function PathGetArgs Lib "shlwapi" Alias "PathGetArgsA" (psz As BytePtr) As BytePtr




'LineInputのエミュレート案
Macro LINEINPUT( FileNumber As Long, ByRef strBuffer As String )
	Dim nLenght As Long
	nLenght = __WsLineInput_GroupOpenCloseAB( FileNumber, strBuffer )
End Macro


'ClipStrのエミュレート案
'最大 MaxGetClipStr [Byte] まで取り込みます。
'  ※10KBとか指定が大きすぎると、ActiveBasicが落ちかねないので注意!
Const MaxGetClipStr = 1024
Function ClipStr() As String
	Dim retAns As Long
	Dim pBuffer As BytePtr
	ClipStr = ZeroString( MaxGetClipStr + 1 )
	pBuffer = StrPtr( ClipStr )
	retAns = WsClipStr( pBuffer, MaxGetClipStr )
	If( retAns=FALSE )Then
		ClipStr = ""
	Else
		ClipStr = pBuffer
	EndIf
EndFunction


'SetClipStrのエミュレート案
Macro SetClipStr( strBuffer As String )
	Dim retAns As Long
	Dim pBuffer As BytePtr
	pBuffer = StrPtr( strBuffer )
	retAns = WsSetClipStr( pBuffer )
End Macro


'OwnerWnd()のエミュレート案
Function OwnerWnd() As Long
	OwnerWnd = WsOwnerWnd()
EndFunction


'CmdLine()のエミュレート案
Function CmdLine() As String
	CmdLine = WsCmdLine()
EndFunction






'*****************************************************************
'以下、エミュレート関数本体。


'クリップボードが文字列であれば、最大nMax文字数をpBufferへ格納。
'返り値はTRUE or FALSE
Function WsClipStr( pBuffer As BytePtr, nMax As Long ) As Long
	Dim pAddUrl As BytePtr
	Dim pMark As BytePtr
	Dim hRawClip As DWord

	'クリップボードを開く
	While ( OpenClipboard(0)=FALSE )
		Sleep (1)
	Wend

	'クリップボードのデータを得る。
	hRawClip = GetClipboardData( CF_TEXT )
	If( hRawClip=NULL )Then
		pMark = NULL
		WsClipStr = FALSE
	Else
		pMark = GlobalLock( hRawClip )
		If( pMark=NULL )Then
			pMark = hRawClip
			pBuffer = WsStrncpy( pBuffer, pMark, nMax-1 )
		Else
			pBuffer = WsStrncpy( pBuffer, pMark, nMax-1 )
			GlobalUnlock( pBuffer )
		EndIf
		WsClipStr = TRUE
	EndIf

	'クリップボードを閉じる
	CloseClipboard()

EndFunction



'クリップボードに文字列を貼り付ける。
'返り値はTRUE
Function WsSetClipStr( pBuffer As BytePtr ) As Long
	Dim nSize As Long
	Dim hGlobalMem As DWord
	Dim pGlobalMemForClipText As BytePtr

	'クリップボードを開く
	While ( OpenClipboard(0)=FALSE )
		Sleep (1)
	Wend

	'クリップボードを空にする。
	EmptyClipboard()

	'貼り付ける文字列の大きさを得て、クリップボード用のバッファを確保
	nSize = lstrlen( pBuffer )
	hGlobalMem = GlobalAlloc( GHND Or GMEM_SHARE, nSize + 1 )
	pGlobalMemForClipText = GlobalLock(hGlobalMem)
		pGlobalMemForClipText = lstrcpy( pGlobalMemForClipText, pBuffer )
	GlobalUnlock( hGlobalMem )
	SetClipboardData( CF_TEXT, hGlobalMem )

	'クリップボードを閉じる
	CloseClipboard()

	WsSetClipStr = TRUE
EndFunction



'LineInputのエミュレート案:本体。
'  FileNumber As Long → Open文で開いたファイルナンバー
'  ByRef strBuffer As String → 読み込む文字列バッファー
'  返り値は、読み込んだ文字数になります。
' ※本家Discoverのプログラム掲示板の「高信期さん」の改良案を利用。
'  ※※対応終端コード:LF, CR, CR+LF
Function __WsLineInput_GroupOpenCloseAB( FileNumber As Long, ByRef strBuffer As String ) As Long
	Dim Buf As BytePtr
	Dim Size As Long
	Dim Length As Long

	FileNumber = FileNumber - 1
	Size = GetFileSize( _System_hFile[FileNumber], 0 ) 
	Size = Size - SetFilePointer( _System_hFile[FileNumber], 0, NULL, FILE_CURRENT )

	Buf = calloc( Size + 1 )
	ReadFile( _System_hFile[FileNumber], Buf, Size, VarPtr(Size), ByVal NULL )

	Length = 0
	While TRUE
		Select Case Buf[Length]
		Case NULL
			Exit While
		Case 10  'LF
			SetFilePointer( _System_hFile[FileNumber], Length + 1 - Size, NULL, FILE_END )
			Exit While
		Case 13  'CR or CRLF
			SetFilePointer( _System_hFile[FileNumber], _
							Length + 1 - ( Buf[Length + 1] = 10 ) - Size, _
							NULL, _
							FILE_END )
			Exit While
		Case Else
			Length = Length + 1
		End Select
	Wend
	strBuffer = ZeroString(Length)
	memcpy(StrPtr(strBuffer), Buf, Length)

	'読み込んだ文字数を返す。
	__WsLineInput_GroupOpenCloseAB = lstrlen( Buf )

	free(Buf)
EndFunction



'プロンプトウインドウのハンドルを得る関数。
Function WsOwnerWnd() As Long
	WsOwnerWnd = _PromptSys_hWnd
EndFunction



'コマンドライン文字列の取得関数。
Function WsCmdLine() As BytePtr
	Dim pRowCodLine As BytePtr
	pRowCodLine = GetCommandLine()
	WsCmdLine = PathGetArgs( pRowCodLine )
EndFunction



'**************************************************************
'  WsClipStr() 内で使用する関数。
'**************************************************************

'NULL文字を含め、文字列 poPaste を最大 nMax 文字まで 文字列バッファpoBuffer にコピーする.
'poBuffer を返す。C言語のstrncpy()に相当。
Function WsStrncpy( poBuffer As BytePtr, poPaste As BytePtr, nMax As Long ) As BytePtr
	WsStrncpy = WsStrCpyNum( poBuffer, poPaste, nMax )
EndFunction
'本体
Function WsStrCpyNum( poBuffer As BytePtr, poPaste As BytePtr, nMax As Long ) As BytePtr
	dim nLength As Long
	dim i As Long
	nLength = lstrlen( poPaste )
	If( nLength<nMax-1 )Then
		poBuffer = lstrcpy( poBuffer, poPaste )
	Else
		For i=0 To nMax-2
			SetByte( poBuffer+i, GetByte( poPaste+i ) )
		Next
		i = nMax-1
		SetByte( poBuffer+i, 0 )
	EndIf
	WsStrCpyNum = poBuffer
EndFunction

#N88BASIC
を指定することを前提にしています。・・・無くても動くのかしら?

使い方は以下のとおり。

LineInput filenumber, buf
 Open命令、Close命令と共に使います。
 Input #1, buf ではカンマ区切りで読み込んできますが、
 LineInput 1, buf では行単位(終端はLF or CR or CR+LF)で読み込みます。
 データを読み取った分、ファイルポインタが移動します。
 bufにはString型を指定してください。
 Input # 命令と混在して使えるのが魅力ですw
   ※【Line Input #1】という記述は出来ません。
    【LineInput 1】でお願いします。

SetClipStr buf
 クリップボードに文字列を格納します。 
 bufには格納する文字列(String型)を指定します。

ClipStr()
 クリップボードにセットされている文字列を取得します。
 クリップボードにテキスト以外のデータがセットされているときは、
 長さが 0 の文字列が返ります。
 定義 Function ClipStr() As String

OwnerWnd()
 メインのプロンプト ウィンドウのウィンドウ ハンドルを取得します。
ウィンドウ ハンドルが返ります。
 定義 Function OwnerWnd() As Long

CmdLine()
 コマンド ライン文字列を取得します(コンパイル時のみ)。
 コマンド ラインが格納された文字列が返ります。
 定義 Function CmdLine() As String


・・・ってVer2.x 時代から使っている方や、未だにVer3.xに
拘っているような方なら、書かなくても分かるでしょうね(^^;)

Ver2.xのヘルプファイルの説明文をだいぶ拝借させていただきましたm(_ _)m
Ver2.x時代と同じ記述ができることを重視していますので。
あの手軽さが好きなのです♪(時代逆行中)
・・・でも、最近はVer3.xの速さに誘惑されてるかな?

蛇足。
Function WsStrncpy() なんぞを定義しているのは、C言語のstrncpy()が
欲しかったから。他にも strstr() や strchr() が欲しかったりしますが、
Apiの定義がわからんのです・・・。なので自作実装。
Apiの宣言の仕方を知ってる方いらっしゃいますか?
居りましたら、ぜひ教えていただきたいのですが・・・。
・・・InStr() があるじゃないか、というツッコミはなしで(苦笑)。


通報する
ページトップ
 記事の件名:
投稿記事Posted: 2005年7月20日(水) 19:49 
オフライン

登録日時: 2005年5月31日(火) 17:59
記事: 895
住所: 東京都
strncpy()の代わりはWin32APIにlstrcpy()が在ります。
Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (pString1 As BytePtr, pString2 As BytePtr, iMaxLength As Long) As BytePtr

ほかにもshlwapi.dllにStrStr()やShrChr()など大抵のものは在りますが、このDLLはIE4以降に付属するものなので、プログラムを実行するユーザがWin95辺りだとIE4以降をインストールしてもらうことになります。


通報する
ページトップ
 記事の件名: lstr周り
投稿記事Posted: 2005年7月21日(木) 08:40 
オフライン

登録日時: 2005年7月19日(火) 07:02
記事: 183
住所: 宮城県
イグトランス様、ありがとうございます。
確かに呼び出せました。
でもlstrcpyA→lstrcpynAの間違いですよね?
最初、オーバーロード?とか思っちゃいました。
コード:
'lstrncpy()
Declare Function lstrncpy Lib "kernel32" Alias "lstrcpynA" _
					( pBuffer1 As BytePtr, _
					  pBuffer2 As BytePtr, _
					  iMaxLength As Long ) As BytePtr
strstrなども見つけられました。shlwapi.dllですか。知りませんでした。
Shell Lightweight Utility APIs:文字列操作が便利になるAPIで、Win98以降なら標準であるみたいですね。

せっかくなので、string.hの標準関数のいくつかをAPIで置き換える場合の宣言をいくつかメモ。
 ※ABのIncludeでまだ定義されていないもの(Ver4.03時点)。
 ※※大文字、小文字は区別しない。区別する場合はAliasから[ I ]を外せばよい。
コード:
'strncat()
Declare Function lstrncat Lib "shlwapi" Alias "StrNCatA" _
			( pString1 As BytePtr, _
			  pString2 As BytePtr, _
			  iMaxLength As Long ) As BytePtr

'strstr()
Declare Function lstrstr Lib "shlwapi" Alias "StrStrIA" _
			( pBuffer1 As BytePtr, _
			  pBuffer2 As BytePtr ) As BytePtr

'strchr()
Declare Function lstrchr Lib "shlwapi" Alias "StrChrIA" _
			( pBuffer1 As BytePtr, _
			  bSearch2 As Byte ) As BytePtr

'strrchr()
Declare Function _lstrrchr Lib "shlwapi" Alias "StrRChrIA" _
			( pBufStart As BytePtr, _
			  pBufEnd As BytePtr, _
			  bSearch2 As Byte ) As BytePtr
Function lstrrchr( pBuffer1 As BytePtr, bSearch2 As Byte ) As BytePtr
	lstrrchr = _lstrrchr( pBuffer1, _
				pBuffer1 + lstrlen(pBuffer1), _
				bSearch2 )
EndFunction
String型で事足りる限りは、つまりはでかい文字列を扱わない限りは、必要の無い関数ですけどね(苦笑)。


通報する
ページトップ
投稿記事Posted: 2005年7月21日(木) 09:11 
オフライン

登録日時: 2005年7月19日(火) 07:02
記事: 183
住所: 宮城県
> String型で事足りる限りは、つまりはでかい文字列を扱わない限りは
Ver3.xで、512(1024だったかな?)ほどのString型配列を用意した際に
スタックオーバーフローで落ちた記憶があったので、こう発言したのですが、
引用:
・データを格納するためのメモリがヒープ領域に設けられる
という文章をHELPに今しがた見つけました。
ということは、Ver4.xであれば、String型で落ちるなんてことを経験した人は居ないんでしょうか?
いえ、ちょっと疑問に思っただけです(^^;)

それから。
MakeStr()は省略しても動きますね。 Ver3.xと互換取れてるようで嬉しいです。


追記その2
strstrなどの実装は、shlwapi.dllを使うより、crtdll.dllを使ったほうが良いんでしょうかねぇ?
引用:
crtdll.dll
CのRunTimeライブラリのDLLで、windowsのシステムディレクトリに最初からある。
だそうなので。・・・いまどき、どっちでも良いですか(^^;)


通報する
ページトップ
投稿記事Posted: 2005年7月21日(木) 16:05 
オフライン

登録日時: 2005年5月31日(火) 10:52
記事: 264
住所: 高知
> 追記その2
> strstrなどの実装は、shlwapi.dllを使うより、crtdll.dllを使ったほうが良いんでしょうかねぇ?

>
引用:
crtdll.dll
> CのRunTimeライブラリのDLLで、windowsのシステムディレクトリに最初からある。
> だそうなので。・・・いまどき、どっちでも良いですか(^^;)

crtdll.dllにはsin()とかcos()とかも最初から入っています。
ですので、今、math.hの移植を行っています。

ついでにprocess.h、time.hも移植してみましたらABでも動きました。
ただbeginthread()関数はABでは少し動作に問題がでましたが
beginthreadex()関数は普通に動きます。

呼び出し規約にさえ気をつければcrtdllを使っても大丈夫でしょう。


通報する
ページトップ
投稿記事Posted: 2006年6月17日(土) 03:11 
お世話になっています。

AV3で動いている"LineInput" を、AV4でデバッグ実行すると、
"LineInput" 無効な識別子です
と言われます。

修正方法などお教え願えれば幸いです。

http://makotowatana.ld.infoseek.co.jp/


通報する
ページトップ
   
投稿記事Posted: 2006年6月17日(土) 22:00 
オフライン

登録日時: 2005年7月19日(火) 07:02
記事: 183
住所: 宮城県
引用:
> 修正方法などお教え願えれば幸いです。
現在AB環境がないので確認できませんが、
以下の修正方法を試してみてください。
コード:
'LineInputのエミュレート案
Macro LINEINPUT( FileNumber As Long, ByRef strBuffer As String )
の部分を
コード:
'LineInputのエミュレート案
Macro LineInput( FileNumber As Long, ByRef strBuffer As String )
に書き換える。

それでもダメな場合は、
コード:
'LineInputのエミュレート案
Macro LINEINPUT( FileNumber As Long, ByRef strBuffer As String )
    Dim nLenght As Long
    nLenght = __WsLineInput_GroupOpenCloseAB( FileNumber, strBuffer )
End Macro
コード:
Sub LineInput( FileNumber As Long, ByRef strBuffer As String )
    Dim nLenght As Long
    nLenght = __WsLineInput_GroupOpenCloseAB( FileNumber, strBuffer )
End Sub
に書き換えて、呼び出し方法をSubにあわせてください。

たしか、上記の方法でAB4でも動作した、と言う話を聞いたことがあります。



蛇足。
AV4=Activebasic Version4.xの略ですよね?
最初、「AVって何??」とか思いましたもんでw


通報する
ページトップ
投稿記事Posted: 2006年6月17日(土) 23:31 
有難うございます。
AB4(VBと混同して、AV4と書きましたが、まさしくAB4のことです。)で、

'LineInputのエミュレート案
をSubにして、
呼び出し方法を、Subにあわせて、LineInput(1, IN_DATA$)のようにしたら、
動きました。

迅速な回答、有難うございました。
m(__)m

ちなみに私は、ABをインストールするフォルダの名前を下記のようにして、3世代のいずれも動くようにしています。
ActiveBasic2
ActiveBasic3
ActiveBasic4
レジストリは一つしか持てないですが、プログラムから直接起動させない限り、問題有りません。


通報する
ページトップ
   
期間内表示:  ソート  
新しいトピックを投稿する  トピックへ返信する  [ 8 件の記事 ] 

All times are UTC+09:00


オンラインデータ

このフォーラムを閲覧中のユーザー: なし & ゲスト[0人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
cron
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by KONISHI Yohsuke