ab.com コミュニティ

[quote]> 　A/Dは、当初は、「USB-IOからディジタル信号を出力してそれをデコードして、A/DのICをチップセレクトするとともに、A/Dのスタートをすれば、A/D変換できる」ぐらいに考えておりました。しかし、取り込みが大変で、「どうやっ[/quote]
考え方はあっています。
A/DのICをチップセレクトするとともに、A/Dのスタート、そして
一定時間後にデータを取得の処理をPICでするか、ABでコーディングするか
の違いになると思います。
USB-Aｎの場合は設定をしておけば、PICが定周期でポートにデータがセット
されるのでそれを任意のタイミングで取り込むようになります。

[quote]> 　当初、私がこのプログラミング質問板コーナーで、質問したのは、Text Editor（メール送信機能付）の送信元名の文字化けの件でしたが、それは、「外部機器を監視して、そのデータを取り込み、処理すれば、自分の携帯電話にメッセージを送れるのでは？」と考えていのが始まりでした。こんなことなどPC98時代には逆立ちしても考えられませんでした。[/quote]
アナログの入力は無かったのですが自分も同じ事をしました。
セキュリティシステムを作りました。
各センサー（赤外線、ドアセンサーなど）の信号をきっかけに
USBカメラで画像を取り、携帯に画像付のメールを送るといったものです。
また、メールでコマンドを送り返せば、警報ブザーのON/OFF
その他機器の制御が出来るようにしていました。
そのときはVBで作成しているのでUSBカメラの制御、画像の処理等のDllが
VBのサンプルにあります。
これらのDllは、ABでも使えると思います。

バケさん、ありがとうございます。

　A/Dは、当初は、「USB-IOからディジタル信号を出力してそれをデコードして、A/DのICをチップセレクトするとともに、A/Dのスタートをすれば、A/D変換できる」ぐらいに考えておりました。しかし、取り込みが大変で、「どうやって取り込めばいいのだろう？」と悩んでおりました。
A/D変換はやはり難しいのですね。
　PC98時代は、98BASICのIN命令、OUT命令、PEEK、POKEで大体何とかなったのですが、大変さを感じています。しかし、大変ではありますが、逆にWindowsのIO制御ですと、PCの画面をモニタにしたりして、幅が広がり、いろんなことができそうです。
　当初、私がこのプログラミング質問板コーナーで、質問したのは、Text Editor（メール送信機能付）の送信元名の文字化けの件でしたが、それは、「外部機器を監視して、そのデータを取り込み、処理すれば、自分の携帯電話にメッセージを送れるのでは？」と考えていのが始まりでした。こんなことなどPC98時代には逆立ちしても考えられませんでした。

何とか方向が見えてきました。
アドバイスありがとうございました。

[quote]> ②スイッチ情報やA/DデータをAB（又はVB）の配列に取り込む。

> もっとも、①を通過してもくぐらなければならないゲートはまだたくさんありますが・・・。（ちなみに②ではどのようにすればよいか私のソフト能力では検討もつきません。）[/quote]

A/Dデータはソフトでは難しいのでハード（AD変換ICやPIC）を使う必要があると思います。
[url]http://km2net.com/[/url]でUSB-Aｎを販売しています。
これは汎用USB-IOとまったく同じコントロールでアナログデータを取り込む事が出来るものです。
汎用USB-IOにPICを乗せてAD変換を行っています。

私のブログ関連記事を載せています。
概要
[url]http://bake-san.com/bdenshi/2005/12/usb-anusb.html[/url]
サンプルプログラム（AB）
[url]http://bake-san.com/bdenshi/2005/12/usb-anpg.html[/url]

参考にして見てください。

バケさん、こんにちは！

応答ありがとうございます。
WindowsのIO制御頑張ります。
ハードがらみのときは、よろしくお願い申し上げます。
すでに、ソフトでは、「バケさんの趣味の部屋」よりvbausbio.dllとbas_vbausbio.basをダウンロードさせて頂き、お世話になっています。
ありがとうございました。

少なくとも「手作りUSB機器」の内容は、実践しようと思います。
とりあえずの目標としては、昔パソコンをいじくっていたときのように、
①スイッチのon/offを読み込んだり（ディジタルデータの入力）、A/D変換をさせる（変換指令としてのディジタルデータの出力）。
②スイッチ情報やA/DデータをAB（又はVB）の配列に取り込む。
③AB（又はVB）で配列データを処理する。
④処理内容によっては、DA変換やディジタル出力を行なう。
など行ないたいと考えています。

ずっとWindowsのIO制御ほとんどあきらめていましたが、「手作りUSB機器」をみて、できるのではないかという感触を得ました。どうでしょうか？
今までは、①の段階で既につまずいていましたから。

もっとも、①を通過してもくぐらなければならないゲートはまだたくさんありますが・・・。（ちなみに②ではどのようにすればよいか私のソフト能力では検討もつきません。）

YKさん、こんにちは

WindowsのIO制御頑張ってくださいね。

「手作りUSB機器」を見て汎用USB-IOの件で結構こちらの掲示板に問い合わせされている方が増えてきていますね。
きっかけを作ったのは私なので、こちらの掲示板もチェックする回数を増やして出来るだけサポートしたいと思っています。

ハードがらみは私に問い合わせをしていただけたらと思います。
[url]http://bake-san.com/[/url]

yu0627さん

　重ね重ね、貴重なアドバイスありがとうございます。手順も初心者用に丁寧に書いてくださいました。
　私のAB歴はほんの1ヶ月にも満たず、超の5乗くらいの初心者なので（・・・***.dllの意味もよくわからないレベルです。）、ちょっとビビッておりますが、挑戦します。（・・・***.dllの意味もよくわからないレベルです。）
　ちなみに、そんな私がABを思い立ったのは、Windowsパソコンで外部機器の制御をしたいと思っていたからです。昔PC98が全盛期の時は、98BASICのインタプリタで、今思えば気の遠くなるようなBASICプログラムを組んでいたこともありましたが、Windowsになってからは、ユーザが容易にI/Oを操作できなくなり、あきらめていました。そんな中、ABを利用した「手作りUSB機器」という本をを知り、またはじめてみようと思った次第です。（今までその類の本を何冊か読んだことがありますが、この本のように具体的にはなかなかはっきり書いてなかったです。）
　もう一度WindowsのIO制御に挑戦しようと思います。

'定数宣言
Const JC_ERROR		=	 0
Const JC_UNKNOWN	=	 0
Const JC_SJIS		=	 4
Const JC_JIS		=	 8
Const JC_EUC		=	12

Declare Function encode64 Lib "base64" (Source As BytePtr, Ret As BytePtr, ByVal Length As Long) As Long
Declare Function decode64 Lib "base64" (base As BytePtr, Ret As BytePtr, ByVal Length As Long) As Long

'JcodeConvert：文字列の文字コードを変換します
Declare Function JcodeConvert Lib "jcode" (
	nSource As Long,			'変換元の文字列の文字コード
	nDest As Long,				'変換先の文字列の文字コード
	lpSource As *Char,			'変換元の文字列
	lpDest As *Char				'変換先の文字列
) As Long
	
'JcodeDetect：文字列の文字コードを判別します
Declare Function JcodeDetect Lib "jcode" (
	lpString As *Char,			'判別する文字列
	nDefault As Long			'デフォルトの文字コード
) As Long

'JcodeEncToJis：EUC文字列をJIS文字列に変換します
Declare Function JcodeEucToJis Lib "jcode" (
	lpSource As *Char,			'変換元の文字列
    lpDest As *Char				'変換先の文字列
) As DWord

'JcodeEucToSjis：EUC文字列をシフトJIS文字列に変換します
Declare Function JcodeEucToSjis Lib "jcode" (
	lpSource As *Char,			'変換元の文字列
	lpDest As *Char				'変換先の文字列
) As DWord

'JcodeJisToEuc：JIS文字列をEUC文字列に変換します
Declare Function JcodeJisToEuc Lib "jcode" (
	lpSource As *Char,			'変換元の文字列
	lpDest As *Char				'変換先の文字列
) As DWord

'JcodeJisToSjis：JIS文字列をシフトJIS文字列に変換します
Declare Function JcodeJisToSjis Lib "jcode" (
	lpSource As *Char,			'変換元の文字列
	lpDest As *Char				'変換先の文字列
) As DWord

'JcodeSjisToEuc：シフトJIS文字列をEUC文字列に変換します
Declare Function JcodeSjisToEuc Lib "jcode" (
	lpSource As *Char,			'変換元の文字列
	lpDest As *Char				'変換先の文字列
) As DWord

'JcodeSjisToJis：シフトJIS文字列をJIS文字列に変換します
Declare Function JcodeSjisToJis Lib "jcode" (
	lpSource As *Char,			'変換元の文字列
	lpDest As *Char				'変換先の文字列
) As DWord

'JcodeVersion：jcode.dllのバージョンを取得します
Declare Function JcodeVersion Lib "jcode" (
	lpBuffer As *Char			'バージョンを格納するバッファ
) As Long

Function SendMailThread(dw As Word) As Dword
	Dim TextBuffer As String	'テキストバッファの格納用
	Dim strJISMain As String	'テキストをJISに変換するときのバッファ
	Dim length As Long			'テキストの長さ
	Dim temporary As String		'送信時のテキスト一時保存用

	Dim buffer As BytePtr
	Dim i As Long, i2 As Long

	'[送信] [閉じる]ボタンを無効にする
	EnableWindow(GetDlgItem(hSendMail, CommandButton1), FALSE)
	EnableWindow(GetDlgItem(hSendMail, CommandButton2), FALSE)

	'各エディットボックスの内容を取得する
	Dim szServerName[255] As Byte		'サーバー名
	Dim szForm[255] As Byte				'送信元アドレス
	Dim szFromName As BytePtr			'送信元名
	Dim szTo[255] As Byte				'送信先アドレス
	Dim szToName As BytePtr				'送信先名
	Dim szSubject As BytePtr			'件名
	Dim lpszJISString As BytePtr		'JIS変換時のバッファ
	Dim lpszBASE64String As BytePtr		'BASE64変換時のバッファ
	Dim lpstrBuffer[225] As Byte		'テキストボックスからのバッファ
	GetWindowText(GetDlgItem(hSendMail, EditBox1), szServerName, 256)
	GetWindowText(GetDlgItem(hSendMail, EditBox2), szForm, 256)
	GetWindowText(GetDlgItem(hSendMail, EditBox3), szTo, 256)
	'GetWindowText(GetDlgItem(hSendMail, EditBox4), szSubject, 256)

	'DLL内の関数を使って送信者名、送信先名、件名を取得（iso-2022-jpエンコード）
	'送信者名------------------------------------------------------------------
	GetDlgItemText(hSendMail, EditBox5, lpstrBuffer, 255)
	If lstrlen(lpstrBuffer)=0 Then
		lstrcpy(lpstrBuffer, " ")
	End If
	lpszJISString=malloc(JcodeSjisToJis(lpstrBuffer, NULL)+10)
	JcodeSjisToJis(lpstrBuffer, lpszJISString)
	lpszBASE64String=malloc(encode64(lpszJISString, NULL, lstrlen(lpszJISString)+10))
	encode64(lpszJISString, lpszBASE64String, lstrlen(lpszJISString))
	szFromName=malloc(lstrlen(lpszBASE64String)+19)
	lstrcpy(szFromName, "=?ISO-2022-JP?B?" & lpszBASE64String & "?=")
	'送信先名------------------------------------------------------------------
	GetDlgItemText(hSendMail, EditBox6, lpstrBuffer, 255)
	If lstrlen(lpstrBuffer)=0 Then
		lstrcpy(lpstrBuffer, " ")
	End If
	lpszJISString=realloc(lpszJISString, JcodeSjisToJis(lpstrBuffer, NULL)+10)
	JcodeSjisToJis(lpstrBuffer, lpszJISString)
	lpszBASE64String=realloc(lpszBASE64String, encode64(lpszJISString, NULL, lstrlen(lpszJISString)+10))
	encode64(lpszJISString, lpszBASE64String, lstrlen(lpszJISString))
	szToName=malloc(lstrlen(lpszBASE64String)+19)
	lstrcpy(szToName, "=?ISO-2022-JP?B?" & lpszBASE64String & "?=")
	'件名---------------------------------------------------------------------
	GetDlgItemText(hSendMail, EditBox4, lpstrBuffer, 255)
	If lstrlen(lpstrBuffer)=0 Then
		lstrcpy(lpstrBuffer, " ")
	End If
	lpszJISString=realloc(lpszJISString, JcodeSjisToJis(lpstrBuffer, NULL)+10)
	JcodeSjisToJis(lpstrBuffer, lpszJISString)
	lpszBASE64String=realloc(lpszBASE64String, encode64(lpszJISString, NULL, lstrlen(lpszJISString)+10))
	encode64(lpszJISString, lpszBASE64String, lstrlen(lpszJISString))
	szSubject=malloc(lstrlen(lpszBASE64String)+19)
	lstrcpy(szSubject, "=?ISO-2022-JP?B?" & lpszBASE64String & "?=")

	'テキストデータを格納するためのバッファ領域を確保し、テキストを取得
	Dim hEdit As Long
	hEdit=GetDlgItem(hMainWnd, EditBox1)
	length=GetWindowTextLength(hEdit)
	TextBuffer=ZeroString(length+1)
	GetWindowText(hEdit, TextBuffer, length+1)
	'テキストをBASE64エンコードして取得
	strJISMain=ZeroString(JcodeSjisToJis(TextBuffer, NULL)+1)
	JcodeSjisToJis(TextBuffer, StrPtr(strJISMain))
	TextBuffer=ZeroString(Len(strJISMain)+1)
	temporary=ZeroString(Len(strJISMain)+3)
	TextBuffer=strJISMain

	'ISO-2022-JP文字列を考慮してbuffer変数のサイズを設定
	buffer=malloc(10*1024)

	'WinSock Ver 1.1の初期化
	Dim wsaData AS WSADATA				'ソケットの初期化情報
	WSAStartup(MAKEWORD(1, 1), wsaData)

	'サーバーを探す
	Dim lpHost As *HOSTENT				'ホスト情報
	lpHost=gethostbyname(szServerName)
	If lpHost=0 Then
		wsprintf(buffer, "%sが見つかりません", szServerName)
		SetDlgItemText(hSendMail, Static_Recv, buffer)

		'[送信] [閉じる]ボタンを有効にする
		EnableWindow(GetDlgItem(hSendMail, CommandButton1), TRUE)
		EnableWindow(GetDlgItem(hSendMail, CommandButton2), TRUE)
		Exit Function
	End If

	'ソケットをオープン
	Dim s As DWord						'ソケット
	s=socket(AF_INET, SOCK_STREAM, 0)
	If s=0 Then
		SetDlgItemText(hSendMail, Static_Recv, "ソケットのオープンに失敗")

		'[送信] [閉じる]ボタンを有効にする
		EnableWindow(GetDlgItem(hSendMail, CommandButton1), TRUE)
		EnableWindow(GetDlgItem(hSendMail, CommandButton2), TRUE)
		Exit Function
	End If

	'メール用のポート番号を取得
	Dim lpServ As *SERVENT				'サービス情報
	Dim sockaddress As SOCKADDR_IN	'アドレス情報
	lpServ = getservbyname("mail", NULL)
	If lpServ=0 Then
		'デフォルトのポート番号を取得
		sockaddress.sin_port=htons(IPPORT_SMTP)
	Else
		sockaddress.sin_port=lpServ->s_port
	End If

	sockaddress.sin_family=AF_INET
	sockaddress.sin_addr=GetDWord(GetDWord(lpHost->h_addr_list))

	'サーバーに接続
	If connect(s, sockaddress, Len(sockaddress)) Then
		SetDlgItemText(hSendMail, Static_Recv, "サーバーへの接続に失敗")

		'[送信] [閉じる]ボタンを有効にする
		EnableWindow(GetDlgItem(hSendMail, CommandButton1), TRUE)
		EnableWindow(GetDlgItem(hSendMail, CommandButton2), TRUE)
		Exit Function
	End If

	FillMemory(buffer, 256, 0)
	recv(s, buffer, 256, 0)
	SetDlgItemText(hSendMail, Static_Recv, buffer)

	wsprintf(buffer, Ex"HELO %s\r\n", szServerName)				'HELOコマンドを送信
	send(s, buffer, lstrlen(buffer), 0)
	FillMemory(buffer, 256, 0)
	recv(s, buffer, 256, 0)
	SetDlgItemText(hSendMail, Static_Recv, buffer)

	wsprintf(buffer, Ex"MAIL FROM:<%s>\r\n", szForm)			'MAIL FROMコマンドを送信
	send(s, buffer, lstrlen(buffer), 0)
	FillMemory(buffer, 256, 0)
	recv(s, buffer, 256, 0)
	SetDlgItemText(hSendMail, Static_Recv, buffer)

	wsprintf(buffer, Ex"RCPT TO:<%s>\r\n", szTo)				'RCPT TOコマンドを送信
	send(s, buffer, lstrlen(buffer), 0)
	FillMemory(buffer, 256, 0)
	recv(s, buffer, 256, 0)
	SetDlgItemText(hSendMail, Static_Recv, buffer)

	lstrcpy(buffer, Ex"DATA\r\n")								'DATAコマンドを送信
	send(s, buffer, lstrlen(buffer), 0)
	FillMemory(buffer, 256, 0)
	recv(s, buffer, 256, 0)
	SetDlgItemText(hSendMail, Static_Recv, buffer)

	'送信時間を送信
	Dim st As SYSTEMTIME
	Dim lpstrSendTime[255] As Byte
	Dim strDayOfWeek As String
	Dim strMonth As String
	GetLocalTime(st)
	Select Case st.wMonth
		Case 1
			strMonth="Jan"
		Case 2
			strMonth="Feb"
		Case 3
			strMonth="Mar"
		Case 4
			strMonth="Apr"
		Case 5
			strMonth="May"
		Case 6
			strMonth="Jun"
		Case 7
			strMonth="Jul"
		Case 8
			strMonth="Aug"
		Case 9
			strMonth="Sep"
		Case 10
			strMonth="Oct"
		Case 11
			strMonth="Nov"
		Case 12
			strMonth="Dec"
	End Select
	Select Case st.wDayOfWeek
		Case 0
			strDayOfWeek="Sun"
		Case 1
			strDayOfWeek="Mon"
		Case 2
			strDayOfWeek="Tue"
		Case 3
			strDayOfWeek="Wed"
		Case 4
			strDayOfWeek="Thu"
		Case 5
			strDayOfWeek="Fri"
		Case 6
			strDayOfWeek="Sat"
	End Select
	wsprintf(lpstrSendTime, Ex"Date: %s, %d %s %d %02d:%02d:%02d\r\n", strDayOfWeek, st.wDay, strMonth, st.wYear, st.wHour, st.wMinute, st.wMinute)
	send(s, lpstrSendTime, lstrlen(lpstrSendTime), 0)

	'FROMを送信
	FillMemory(buffer, 256, 0)
	wsprintf(buffer, Ex"From: %s <%s>\r\n", szFromName, szForm)
	send(s, buffer, lstrlen(buffer), 0)

	'TOを送信
	FillMemory(buffer, 256, 0)
	wsprintf(buffer, Ex"To: %s <%s>\r\n", szToName, szTo)
	send(s, buffer, lstrlen(buffer), 0)

	'件名を送信
	FillMemory(buffer, 256, 0)
	wsprintf(buffer, Ex"Subject: %s \r\n", szSubject)
	send(s, buffer, lstrlen(buffer), 0)

	'メーラー名を送信
	FillMemory(buffer, 256, 0)
	lstrcpy(buffer, Ex"X-Mailer: Test-Mailer\r\n")
	send(s, buffer, lstrlen(buffer), 0)

	'MIMEタイプを送信
	FillMemory(buffer, 256, 0)
	lstrcpy(buffer, Ex"Content-Type: text/plain; charset=\qISO-2022-JP\q\r\n")
	send(s, buffer, lstrlen(buffer), 0)

	lstrcpy(buffer, Ex"\r\n")
	send(s, buffer, lstrlen(buffer), 0)

	'メール本文を送信
	i=0
	i2=0
	Do
		If (TextBuffer=13 and TextBuffer[i+1]=10) or TextBuffer=0 Then
			'改行
			temporary[i2]=0
			lstrcat(temporary, Ex"\r\n")

			'送信
			send(s, temporary, lstrlen(temporary), 0)

			If TextBuffer=0 Then Exit Do

			i=i+2
			i2=0
			Continue
		End If
		temporary[i2]=TextBuffer

		i=i+1
		i2=i2+1
	Loop

	lstrcpy(buffer, Ex".\r\n")
	send(s, buffer, lstrlen(buffer), 0)
	FillMemory(buffer, 256, 0)
	recv(s, buffer, 256, 0)
	SetDlgItemText(hSendMail, Static_Recv, buffer)

	lstrcpy(buffer, Ex"QUIT\r\n")									'QUITコマンドを送信
	send(s, buffer, lstrlen(buffer), 0)
	FillMemory(buffer, 256, 0)
	recv(s, buffer, 256, 0)
	SetDlgItemText(hSendMail, Static_Recv, buffer)

	'ソケットへの接続を閉じる
	shutdown(s, SD_BOTH)
	closesocket(s)

	'WinSockが使用したメモリを開放
	WSACleanup()

	SetDlgItemText(hSendMail, Static_Recv, "送信が完了しました")

	'[送信] [閉じる]ボタンを有効にする
	EnableWindow(GetDlgItem(hSendMail, CommandButton1), TRUE)
	EnableWindow(GetDlgItem(hSendMail, CommandButton2), TRUE)
End Function

　...というわけで、TextEditorのメール送信プログラムのバグ取り＆送信元名・送信先名・件名の日本語対応化を行いました。
長いですが、ビビらないでくださいね＾＾；

　まず、↓から「jcode.dll」をダウンロードしてください。
[url]http://www.vector.co.jp/soft/win95/prog/se281764.html[/url]
そして、↓から「base64.dll」をダウンロードしてください
[url]http://hira.hopto.org/ab.htm[/url]
そして、解凍して出てきたDLLをTextEditorと同じフォルダに放り込んでください。

　そしたら、SendMailのダイアログを↓の写真のように変更してください。
[url]http://www.exfiction.net/~yu0627/temp/tesmdss.gif[/url]

　そしたら、「SendMail.sbp」の最上部に以下のコードを追加してください。

[hide][code]'定数宣言
Const JC_ERROR = 0
Const JC_UNKNOWN = 0
Const JC_SJIS = 4
Const JC_JIS = 8
Const JC_EUC = 12

Declare Function encode64 Lib "base64" (Source As BytePtr, Ret As BytePtr, ByVal Length As Long) As Long
Declare Function decode64 Lib "base64" (base As BytePtr, Ret As BytePtr, ByVal Length As Long) As Long

'JcodeConvert：文字列の文字コードを変換します
Declare Function JcodeConvert Lib "jcode" (
nSource As Long, '変換元の文字列の文字コード
nDest As Long, '変換先の文字列の文字コード
lpSource As *Char, '変換元の文字列
lpDest As *Char '変換先の文字列
) As Long

'JcodeDetect：文字列の文字コードを判別します
Declare Function JcodeDetect Lib "jcode" (
lpString As *Char, '判別する文字列
nDefault As Long 'デフォルトの文字コード
) As Long

'JcodeEncToJis：EUC文字列をJIS文字列に変換します
Declare Function JcodeEucToJis Lib "jcode" (
lpSource As *Char, '変換元の文字列
lpDest As *Char '変換先の文字列
) As DWord

'JcodeEucToSjis：EUC文字列をシフトJIS文字列に変換します
Declare Function JcodeEucToSjis Lib "jcode" (
lpSource As *Char, '変換元の文字列
lpDest As *Char '変換先の文字列
) As DWord

'JcodeJisToEuc：JIS文字列をEUC文字列に変換します
Declare Function JcodeJisToEuc Lib "jcode" (
lpSource As *Char, '変換元の文字列
lpDest As *Char '変換先の文字列
) As DWord

'JcodeJisToSjis：JIS文字列をシフトJIS文字列に変換します
Declare Function JcodeJisToSjis Lib "jcode" (
lpSource As *Char, '変換元の文字列
lpDest As *Char '変換先の文字列
) As DWord

'JcodeSjisToEuc：シフトJIS文字列をEUC文字列に変換します
Declare Function JcodeSjisToEuc Lib "jcode" (
lpSource As *Char, '変換元の文字列
lpDest As *Char '変換先の文字列
) As DWord

'JcodeSjisToJis：シフトJIS文字列をJIS文字列に変換します
Declare Function JcodeSjisToJis Lib "jcode" (
lpSource As *Char, '変換元の文字列
lpDest As *Char '変換先の文字列
) As DWord

'JcodeVersion：jcode.dllのバージョンを取得します
Declare Function JcodeVersion Lib "jcode" (
lpBuffer As *Char 'バージョンを格納するバッファ
) As Long[/code][/hide]
　そして、SendMailThread関数を以下のように書き換えてください。

[hide][code]Function SendMailThread(dw As Word) As Dword
Dim TextBuffer As String 'テキストバッファの格納用
Dim strJISMain As String 'テキストをJISに変換するときのバッファ
Dim length As Long 'テキストの長さ
Dim temporary As String '送信時のテキスト一時保存用

Dim buffer As BytePtr
Dim i As Long, i2 As Long

'[送信] [閉じる]ボタンを無効にする
EnableWindow(GetDlgItem(hSendMail, CommandButton1), FALSE)
EnableWindow(GetDlgItem(hSendMail, CommandButton2), FALSE)

'各エディットボックスの内容を取得する
Dim szServerName[255] As Byte 'サーバー名
Dim szForm[255] As Byte '送信元アドレス
Dim szFromName As BytePtr '送信元名
Dim szTo[255] As Byte '送信先アドレス
Dim szToName As BytePtr '送信先名
Dim szSubject As BytePtr '件名
Dim lpszJISString As BytePtr 'JIS変換時のバッファ
Dim lpszBASE64String As BytePtr 'BASE64変換時のバッファ
Dim lpstrBuffer[225] As Byte 'テキストボックスからのバッファ
GetWindowText(GetDlgItem(hSendMail, EditBox1), szServerName, 256)
GetWindowText(GetDlgItem(hSendMail, EditBox2), szForm, 256)
GetWindowText(GetDlgItem(hSendMail, EditBox3), szTo, 256)
'GetWindowText(GetDlgItem(hSendMail, EditBox4), szSubject, 256)

'DLL内の関数を使って送信者名、送信先名、件名を取得（iso-2022-jpエンコード）
'送信者名------------------------------------------------------------------
GetDlgItemText(hSendMail, EditBox5, lpstrBuffer, 255)
If lstrlen(lpstrBuffer)=0 Then
lstrcpy(lpstrBuffer, " ")
End If
lpszJISString=malloc(JcodeSjisToJis(lpstrBuffer, NULL)+10)
JcodeSjisToJis(lpstrBuffer, lpszJISString)
lpszBASE64String=malloc(encode64(lpszJISString, NULL, lstrlen(lpszJISString)+10))
encode64(lpszJISString, lpszBASE64String, lstrlen(lpszJISString))
szFromName=malloc(lstrlen(lpszBASE64String)+19)
lstrcpy(szFromName, "=?ISO-2022-JP?B?" & lpszBASE64String & "?=")
'送信先名------------------------------------------------------------------
GetDlgItemText(hSendMail, EditBox6, lpstrBuffer, 255)
If lstrlen(lpstrBuffer)=0 Then
lstrcpy(lpstrBuffer, " ")
End If
lpszJISString=realloc(lpszJISString, JcodeSjisToJis(lpstrBuffer, NULL)+10)
JcodeSjisToJis(lpstrBuffer, lpszJISString)
lpszBASE64String=realloc(lpszBASE64String, encode64(lpszJISString, NULL, lstrlen(lpszJISString)+10))
encode64(lpszJISString, lpszBASE64String, lstrlen(lpszJISString))
szToName=malloc(lstrlen(lpszBASE64String)+19)
lstrcpy(szToName, "=?ISO-2022-JP?B?" & lpszBASE64String & "?=")
'件名---------------------------------------------------------------------
GetDlgItemText(hSendMail, EditBox4, lpstrBuffer, 255)
If lstrlen(lpstrBuffer)=0 Then
lstrcpy(lpstrBuffer, " ")
End If
lpszJISString=realloc(lpszJISString, JcodeSjisToJis(lpstrBuffer, NULL)+10)
JcodeSjisToJis(lpstrBuffer, lpszJISString)
lpszBASE64String=realloc(lpszBASE64String, encode64(lpszJISString, NULL, lstrlen(lpszJISString)+10))
encode64(lpszJISString, lpszBASE64String, lstrlen(lpszJISString))
szSubject=malloc(lstrlen(lpszBASE64String)+19)
lstrcpy(szSubject, "=?ISO-2022-JP?B?" & lpszBASE64String & "?=")

'テキストデータを格納するためのバッファ領域を確保し、テキストを取得
Dim hEdit As Long
hEdit=GetDlgItem(hMainWnd, EditBox1)
length=GetWindowTextLength(hEdit)
TextBuffer=ZeroString(length+1)
GetWindowText(hEdit, TextBuffer, length+1)
'テキストをBASE64エンコードして取得
strJISMain=ZeroString(JcodeSjisToJis(TextBuffer, NULL)+1)
JcodeSjisToJis(TextBuffer, StrPtr(strJISMain))
TextBuffer=ZeroString(Len(strJISMain)+1)
temporary=ZeroString(Len(strJISMain)+3)
TextBuffer=strJISMain

'ISO-2022-JP文字列を考慮してbuffer変数のサイズを設定
buffer=malloc(10*1024)

'WinSock Ver 1.1の初期化
Dim wsaData AS WSADATA 'ソケットの初期化情報
WSAStartup(MAKEWORD(1, 1), wsaData)

'サーバーを探す
Dim lpHost As *HOSTENT 'ホスト情報
lpHost=gethostbyname(szServerName)
If lpHost=0 Then
wsprintf(buffer, "%sが見つかりません", szServerName)
SetDlgItemText(hSendMail, Static_Recv, buffer)

'[送信] [閉じる]ボタンを有効にする
EnableWindow(GetDlgItem(hSendMail, CommandButton1), TRUE)
EnableWindow(GetDlgItem(hSendMail, CommandButton2), TRUE)
Exit Function
End If

'ソケットをオープン
Dim s As DWord 'ソケット
s=socket(AF_INET, SOCK_STREAM, 0)
If s=0 Then
SetDlgItemText(hSendMail, Static_Recv, "ソケットのオープンに失敗")

'[送信] [閉じる]ボタンを有効にする
EnableWindow(GetDlgItem(hSendMail, CommandButton1), TRUE)
EnableWindow(GetDlgItem(hSendMail, CommandButton2), TRUE)
Exit Function
End If

'メール用のポート番号を取得
Dim lpServ As *SERVENT 'サービス情報
Dim sockaddress As SOCKADDR_IN 'アドレス情報
lpServ = getservbyname("mail", NULL)
If lpServ=0 Then
'デフォルトのポート番号を取得
sockaddress.sin_port=htons(IPPORT_SMTP)
Else
sockaddress.sin_port=lpServ->s_port
End If

sockaddress.sin_family=AF_INET
sockaddress.sin_addr=GetDWord(GetDWord(lpHost->h_addr_list))

'サーバーに接続
If connect(s, sockaddress, Len(sockaddress)) Then
SetDlgItemText(hSendMail, Static_Recv, "サーバーへの接続に失敗")

'[送信] [閉じる]ボタンを有効にする
EnableWindow(GetDlgItem(hSendMail, CommandButton1), TRUE)
EnableWindow(GetDlgItem(hSendMail, CommandButton2), TRUE)
Exit Function
End If

FillMemory(buffer, 256, 0)
recv(s, buffer, 256, 0)
SetDlgItemText(hSendMail, Static_Recv, buffer)

wsprintf(buffer, Ex"HELO %s\r\n", szServerName) 'HELOコマンドを送信
send(s, buffer, lstrlen(buffer), 0)
FillMemory(buffer, 256, 0)
recv(s, buffer, 256, 0)
SetDlgItemText(hSendMail, Static_Recv, buffer)

wsprintf(buffer, Ex"MAIL FROM:<%s>\r\n", szForm) 'MAIL FROMコマンドを送信
send(s, buffer, lstrlen(buffer), 0)
FillMemory(buffer, 256, 0)
recv(s, buffer, 256, 0)
SetDlgItemText(hSendMail, Static_Recv, buffer)

wsprintf(buffer, Ex"RCPT TO:<%s>\r\n", szTo) 'RCPT TOコマンドを送信
send(s, buffer, lstrlen(buffer), 0)
FillMemory(buffer, 256, 0)
recv(s, buffer, 256, 0)
SetDlgItemText(hSendMail, Static_Recv, buffer)

lstrcpy(buffer, Ex"DATA\r\n") 'DATAコマンドを送信
send(s, buffer, lstrlen(buffer), 0)
FillMemory(buffer, 256, 0)
recv(s, buffer, 256, 0)
SetDlgItemText(hSendMail, Static_Recv, buffer)

'送信時間を送信
Dim st As SYSTEMTIME
Dim lpstrSendTime[255] As Byte
Dim strDayOfWeek As String
Dim strMonth As String
GetLocalTime(st)
Select Case st.wMonth
Case 1
strMonth="Jan"
Case 2
strMonth="Feb"
Case 3
strMonth="Mar"
Case 4
strMonth="Apr"
Case 5
strMonth="May"
Case 6
strMonth="Jun"
Case 7
strMonth="Jul"
Case 8
strMonth="Aug"
Case 9
strMonth="Sep"
Case 10
strMonth="Oct"
Case 11
strMonth="Nov"
Case 12
strMonth="Dec"
End Select
Select Case st.wDayOfWeek
Case 0
strDayOfWeek="Sun"
Case 1
strDayOfWeek="Mon"
Case 2
strDayOfWeek="Tue"
Case 3
strDayOfWeek="Wed"
Case 4
strDayOfWeek="Thu"
Case 5
strDayOfWeek="Fri"
Case 6
strDayOfWeek="Sat"
End Select
wsprintf(lpstrSendTime, Ex"Date: %s, %d %s %d %02d:%02d:%02d\r\n", strDayOfWeek, st.wDay, strMonth, st.wYear, st.wHour, st.wMinute, st.wMinute)
send(s, lpstrSendTime, lstrlen(lpstrSendTime), 0)

'FROMを送信
FillMemory(buffer, 256, 0)
wsprintf(buffer, Ex"From: %s <%s>\r\n", szFromName, szForm)
send(s, buffer, lstrlen(buffer), 0)

'TOを送信
FillMemory(buffer, 256, 0)
wsprintf(buffer, Ex"To: %s <%s>\r\n", szToName, szTo)
send(s, buffer, lstrlen(buffer), 0)

'件名を送信
FillMemory(buffer, 256, 0)
wsprintf(buffer, Ex"Subject: %s \r\n", szSubject)
send(s, buffer, lstrlen(buffer), 0)

'メーラー名を送信
FillMemory(buffer, 256, 0)
lstrcpy(buffer, Ex"X-Mailer: Test-Mailer\r\n")
send(s, buffer, lstrlen(buffer), 0)

'MIMEタイプを送信
FillMemory(buffer, 256, 0)
lstrcpy(buffer, Ex"Content-Type: text/plain; charset=\qISO-2022-JP\q\r\n")
send(s, buffer, lstrlen(buffer), 0)

lstrcpy(buffer, Ex"\r\n")
send(s, buffer, lstrlen(buffer), 0)

'メール本文を送信
i=0
i2=0
Do
If (TextBuffer[i]=13 and TextBuffer[i+1]=10) or TextBuffer[i]=0 Then
'改行
temporary[i2]=0
lstrcat(temporary, Ex"\r\n")

'送信
send(s, temporary, lstrlen(temporary), 0)

If TextBuffer[i]=0 Then Exit Do

i=i+2
i2=0
Continue
End If
temporary[i2]=TextBuffer[i]

i=i+1
i2=i2+1
Loop

lstrcpy(buffer, Ex".\r\n")
send(s, buffer, lstrlen(buffer), 0)
FillMemory(buffer, 256, 0)
recv(s, buffer, 256, 0)
SetDlgItemText(hSendMail, Static_Recv, buffer)

lstrcpy(buffer, Ex"QUIT\r\n") 'QUITコマンドを送信
send(s, buffer, lstrlen(buffer), 0)
FillMemory(buffer, 256, 0)
recv(s, buffer, 256, 0)
SetDlgItemText(hSendMail, Static_Recv, buffer)

'ソケットへの接続を閉じる
shutdown(s, SD_BOTH)
closesocket(s)

'WinSockが使用したメモリを開放
WSACleanup()

SetDlgItemText(hSendMail, Static_Recv, "送信が完了しました")

'[送信] [閉じる]ボタンを有効にする
EnableWindow(GetDlgItem(hSendMail, CommandButton1), TRUE)
EnableWindow(GetDlgItem(hSendMail, CommandButton2), TRUE)
End Function[/code][/hide]
　そして、送信してみてください。
件名と送信元・先名に日本語を入力しても文字化けしていないはずです。
しかし、まだSMTPの認証システムであるPOPbeforeSMTPとSMTP認証には対応しておりません。
対応してほしい場合には、また言ってください。
まだAB（プログラミング）を始めて1年2ヶ月ぐらいなのでソースは汚いですが＾＾；

yu0627さん、nekoさん、早速の応答ありがとうございました。
yu0627さん
　バグの件は知りませんでした。
　申し訳ありませんでした、「送信元名」です。
　「送信元名、送信先名、件名はTextEditorのそのままで日本語を使うと文字化けを起こしてしまいます。」とのこと、厄介そうですね。私のプログラミング能力？では手に負えそうもありません。ご紹介のサイトは是非訪問させていただきます。
nekoさん
　ガイドに付属していたCDよりロードしたTextEditorのプロジェクトファイルより実行したので、リストに関して細かく比較はしていません。プリントしてつき合わせてみます。そういわれてみれば、昔N88BASICでプログラミングしてたころは丁寧にリストの検証をしてました。

お二方の貴重なご助言に従ってもう一度再トライします。

思い出しましたが、TextEditorのメール送信部分はバグが多いです。前にこちらの環境ではメール送信自体が出来ませんでした。
これは携帯のフルブラウザから投稿していますので、パソコンをつけ次第改良プログラムを作成したいと思います。

私も超々初心者なんですが、p158の図6-8を見ると、送信元アドレスであっていますね。
まだ私はそこまで到達していないので、サンプルのプログラムで見てみましたが、文字化けはしません。
サンプルの物と比較して違ってるところはありませんか？
（私は厳密な型チェックを行うにしておくと、警告がたくさん出てしまうのが気になります(^^;）

　「送信元アドレス」と書いてありますが、実際は「送信元名」の筈です。
　送信元名、送信先名、件名はTextEditorのそのままで日本語を使うと文字化けを起こしてしまいます。
そのため、その部分にはJISコードに変換→BASE64に変換→ISO-2022-JP文字情報文字列（？）を付加しなくてはなりません。
ですので、それをするには大改造が必要となります。
僕のサイト（http://www.exfiction.net/~yu0627/）のパソコン→フリーソフト配布にTextEditorのメール送信機能を核として作った「LightMailSender」というそふとがあります。
それで送信してみてください。

誤ってバグ報告の方に質問してしまいましたので、こちらに改めて質問させていただきました。
Active　Basicの超初心者です。
　かつては、PC88、PC98シリーズではBASICでIOポートからハード制御など行なっていたこともありますが、Windowsになってからは手軽には踏み込めず、あきらめておりました。
　しかし、『手作りUSB機器』という書籍でAB4を知り、USBから手軽にIO制御を行えることがわかり、また電子工作を始めてみよう！と考えた次第です。
　（まずはABに慣れるべく、ActiveBasicオフィシャルユーザーズガイドにて勉強しようと思い立ち・・・）
　さて、質問は「ActiveBasicオフィシャルユーザーズガイドP132にあるサンプルのTextEditorですが、AB Ver4.22.00で実行すると、送信元アドレスが文字化けしてしまい、これを回避するにはどうすればよいでしょうか？」ということです。その他は正常に動作しているようです。ガイドではVer3.1.0であり、そのへんのところが関係しているのかとか、どこを見直せばよいかなかなかわからず、アドバイスをお願いしたいと考えた次第です。
　よろしくお願い申し上げます。