WILLはネットワークに関するあらゆるソリューションをご提供します。
	株式会社ウィル

概 要

Remote Shell/Execは、VB5で記述されたリモートシェル/実行およびそのソースコードをパッケージしたものです。実行するには、別 途TCPIPOCX.EXE（シェアウェア）に含まれるTCPIP.OCXが必要です。Rsh.exeは2つの機能を併せ持ったサンプルです。BSD系UNIXのrshdまたはrexecdと通 信を行い、サーバー上のUNIXコマンドを実行し、その結果を画面に表示します。前者をリモートシェル、後者をリモート実行と呼びます。 リモートシェルの場合、rsh.exe を実行するPCとUNIXコマンドを実行するサーバーは.rhostsと呼ばれるファイルを用いて信頼関係を結びます。これにより、rsh.exeはパスワード無しにサーバーのUNIXコマンドを実行することができます（PCと信頼関係を結ぶことは、セキュリティ上問題になることがありますので、管理者とよく相談の上行ってください）。 リモート実行の場合、サーバーはUNIXコマンドを実行する前に、パスワードの確認を行います（パスワードは、ネットワーク上を暗号化されずにながれます）。 Windows95およびWindowsNT4.0で動作確認しています。

使い方

リモートシェルの場合 「リモートホスト名」、「リモートユーザー名」、「ローカルユーザー名」を入力します。 リモート実行の場合 「リモートホスト名」、「ユーザー名」、「パスワード」を入力します。 「プロトコル」のRSHを選択します。 受信する文字列の「漢字コード」を指定します（JISの場合は自動判別 します。EUC,SJISの場合は取りあえず変換するデフォルトの漢字コードとなります）。 「コマンド」を入力します。 必要に応じて「標準入力」に入力をします。 「実行」ボタンをクリックします。 結果が「標準出力」に表示されます。エラーの場合は「標準エラー出力」にエラーの内容が表示されます。

ソースコード

'Remote Shell/Exec Ver1.0(C)COPYRIGHT 1997, 1999 WILL
Option Explicit
Private m_Code$'フラグ：受信したデータの1バイト目。エラーの有無を示す
Private m_Stat%'どういう状態か。
　　　　　　　　'1:エラーポートを送信した
　　　　　　　　'3:エラーポートの送信完了した
　　　　　　　　'5:エラーポートに関する応答を受け取った
　　　　　　　　'7:データを送信できる状態になった
　　　　　　　　'8:データを送信した
'ログインしているユーザー名を取得するためのWinAPI
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (lpBuffer As Byte, nSize As Long) As Long

'実行ボタン
Private Sub Command1_Click()
　　'Closedイベントがあがるまで、実行ボタンは押せない
　　Command1.Enabled = False
　　'中断ボタンを有効にする
　　Command2.Enabled = True
　　'まだ１バイト目を受信していない
　　m_Code = ""
　　m_Stat = 0
　　On Error GoTo err1
　　If Option1(0).Value = True Then
　　　　'Rshは、ポート514。ローカルポートは特権ポートを使用する
　　　　Tcpip1.Connect Text1, "514", "-1"
　　Else
　　　　'REXECは、ポート512。ローカルポートは一般ポートを使用する
　　　　Tcpip1.Connect Text1, "512", "0"
　　End If
　　Exit Sub

err1:
　　MsgBox Err.Description & "(" & Err.Number & ")", vbExclamation, "Connect"
　　Command1.Enabled = True
　　Command2.Enabled = False
End Sub

'中断ボタン
Private Sub Command2_Click()
    Dim d$
    
    If (Tcpip2.State = 7) Then 'STATE_CONNCTED = 7
        '通信中ならSIGINT(^C)を送出してリモートプログラムを止めようとする
		'止まるかどうかはリモートのプログラム次第
        d = ChrB$(2) 'SIGINT
        Tcpip2.Send d
    Else
        '通信が始まっていないので強制終了
		'Connect中であればClosedイベントがあがる
        Tcpip1.Close
        Tcpip2.Close
    End If
End Sub

'終了ボタン
Private Sub Command3_Click()
    '特別な処理は不要
    Unload Me
End Sub

'フォームロード
Private Sub Form_Load()
    Dim r&, n&, s$, B() As Byte
    'TCPIPOCXの著作権表示
    Label4 = Tcpip1.copyright
    'KANJIOCXの著作権表示
    Label11 = Kanji1.copyright
    'ユーザー名の取得
    n = 255
    ReDim B(n - 1)
    r = GetUserName(B(0), n)
    If (r <> 0 And n > 0) Then '0は失敗を示す
        ReDim Preserve B(n - 1)'0からn-1までのnバイト 
        s = B
        s = StrConv(s, vbUnicode)
        Text2 = Left$(s, n - 1) 'chr$(0)がお尻に付いている
        Text3 = Left$(s, n - 1)
        'ユーザー名が取得できるときはローカルユーザー名は変更不可
        Text3.Enabled = False
    End If
    Kanji1.DefaultEncoding = "EUC"
End Sub

Private Sub Option2_Click(Index As Integer)
    '受信した文字列に含まれる漢字コードを自動判別できない
	'場合にとりあえず変換するデフォルトの漢字コード
    Select Case Index
    Case 0 'EUC
        Kanji1.DefaultEncoding = "EUC"
    Case 1 'SJIS
        Kanji1.DefaultEncoding = "SJIS"
    Case 2 'JIS
		'これは自動判別可能
    End Select
End Sub

'通信が切断された
Private Sub Tcpip1_Closed()
    '次のConnectメソッド実行可
    Command1.Enabled = True
    '中断ボタンを無効にする
    Command2.Enabled = False
End Sub

'接続した
Private Sub Tcpip1_Connected()
    Dim d$
    
    '出力エリアをクリア
    Text6 = ""
    Text7 = ""
    If Option1(0).Value = True Then
        'Rshの標準エラー出力は別のコントロール(特権ポート)で受ける
        Tcpip2.Listen "-1"
    Else
        'REXECの標準エラー出力は別のコントロール(一般ポート)で受ける
        Tcpip2.Listen "0"
    End If
    '標準エラー出力用コントロールのポート番号をサーバーに伝える
    d = CStr(Tcpip2.LocalPort) & Chr$(0)
    If Option1(0).Value = True Then 'RSH
        'ローカルユーザー名
        d = d & Text3 & Chr$(0)
        'リモートユーザー名
        d = d & Text2 & Chr$(0)
    Else
        'リモートユーザー名
        d = d & Text2 & Chr$(0)
        'パスワード
        d = d & Text8 & Chr$(0)
    End If
    'コマンド
    d = d & Text4 & Chr$(0)
    'エラーポートなどを送信する
    m_Stat = 1
    'UNICODE文字列をANSI/DBCS文字列へ変換して送信
    d = StrConv(d, vbFromUnicode)
    Tcpip1.Send d
End Sub

'送信処理
Private Sub SendData()
    Dim d$, p%, x$
    
    If m_Stat = 7 Then
        'データを送信する
        m_Stat = 8
        '標準入力
        d = Text5
        'CRLFをLFに置き換える
        p = Replace(1, d, vbCrLf, vbLf)
        'pが0なら、置き換えるべきLFはない
        Do While p > 0
            p = Replace(p, d, vbCrLf, vbLf)
        Loop
        'UNICODE文字列をANSI/DBCS文字列へ変換して送信
        If Option2(0).Value = True Then 'EUC
            x = Kanji1.Unicode2Euc(d)
        ElseIf Option2(1).Value = True Then 'SJIS
            x = Kanji1.Unicode2Sjis(d)
        Else 'JIS
            x = Kanji1.Unicode2Jis(d)
        End If
        Tcpip1.Send x
    End If
End Sub

'受信した
Private Sub Tcpip1_Received(data As String)
    Dim d$  '受信した文字列をUNICODEに変換したもの
    Dim p%  'LFの検索開始位置
    Static Flagment$    '漢字コードの断片を格納する
	'受信したデータの1バイト目か？
    If (LenB(m_Code) = 0) Then
        '1バイト目を取り出す
        m_Code = LeftB$(data, 1)
        'dataに2バイト目以降を残す
        data = MidB$(data, 2)
        '断片をクリアしておく
        Flagment = ""
        'エラーがないことを確認し、
        If (m_Code = ChrB$(0)) Then
            '標準出力データを送信できるものなら送信する
            m_Stat = m_Stat Or 4
            SendData
        End If
    End If
    
    '未処理の漢字の断片にデータを追加する
    Flagment = Flagment & data
    '漢字をSJISに変換する。処理できないものはFlagmentに残る
    d = Kanji1.Any2Sjis(Flagment)
    'VBで処理できるようにANSI/DBCSからUNICODEに変換する
    d = StrConv(d, vbUnicode)
    'LFをCRLFに置き換える
    p = Replace(1, d, vbLf, vbCrLf)
    'pが0なら、置き換えるべきLFはない
    Do While p > 0
        p = Replace(p, d, vbLf, vbCrLf)
    Loop
    
    If (m_Code = ChrB$(0)) Then
        'エラーがない
        Text6 = Text6 & d
    Else
        'エラー。残りのデータはエラーメッセージ
        Text7 = Text7 & d
        'LFを見つけたらエラーメッセージの終わり
        If (InStr(Text7, vbLf) > 0) Then
            Tcpip1.Close
        End If
    End If
End Sub

'送信したデータが送信された
Private Sub Tcpip1_Sent()
    Dim d$
    Select Case m_Stat
    Case 1
        m_Stat = m_Stat Or 2
        SendData
    Case 2, 4, 7
        'ありえない
    Case 3, 5
        'なにもしない
    Case 8
        '標準出力のデータを送信し終わると送信口を閉じて
		'送信データの終わりをサーバーに伝える
        m_Stat = 9
        If LenB(Text5) > 0 Or Check1.Value = 1 Then
            Tcpip1.Shutdown 1
        End If
    End Select
End Sub

'Winsockの非同期処理中にエラーが発生した
Private Sub Tcpip1_WsError(ByVal Ecode As Long, ByVal Description As String, ByVal Where As String, CancelClose As Boolean)
    MsgBox Ecode & ":" & Description, vbExclamation, "Tcpip1_WsError(" & Where & ")"
End Sub

'標準エラー出力用コントロールに接続要求が来た
Private Sub Tcpip2_Accepting(ByVal NewSocket As Long, ByVal RemoteIp As Long, ByVal RemotePort As Integer, CancelAccept As Boolean)
    '接続待ちコントロールの役割を終えて、
    Tcpip2.Close
    '通信コントロールに変身する
    Tcpip2.Accept NewSocket
End Sub

'標準エラー出力データを受信した
Private Sub Tcpip2_Received(data As String)
    Dim d$  '受信した文字列をUNICODEに変換したもの
    Dim p%  'LFの検索開始位置
	'VBで処理できるようにANSI/DBCSからUNICODEに変換する
    d = StrConv(data, vbUnicode)
    'LFをCRLFに置き換える
    p = Replace(1, d, vbLf, vbCrLf)
    'pが0なら、置き換えるべきLFはない
    Do While p > 0
        p = Replace(p, d, vbLf, vbCrLf)
    Loop
    Text7 = Text7 & d
End Sub

'文字列の置き換えを行う関数
Private Function Replace%(ByVal i%, org$, ByVal src$, ByVal dst$)
    Dim p%  '検索文字の位置
    Dim L$  '検索文字の直前までの文字列
    Dim r$  '検索文字の直後からの文字列
	'対象となる文字列から検索する文字列を探す
    p = InStr(i, org, src)
    '見つかったら
    If (p > 0) Then
        '直前の文字列と
        L = Left$(org, p - 1)
        '直後の文字列で
        r = Mid(org, p + Len(src))
        '検索文字列を挟む
        org = L & dst & r
        '直後の文字列の先頭位置を返す
        Replace = p + Len(dst)
    Else
        '見つからない場合は0を返す
        Replace = 0
    End If
End Function

'Winsockの非同期処理中にエラーが発生した
Private Sub Tcpip2_WsError(ByVal Ecode As Long, ByVal Description As String, ByVal Where As String, CancelClose As Boolean)
    MsgBox Ecode & ":" & Description, vbExclamation, "Tcpip2_WsError(" & Where & ")"
End Sub

Private Sub Text1_GotFocus()
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1)
End Sub

Private Sub Text2_GotFocus()
    Text2.SelStart = 0
    Text2.SelLength = Len(Text2)

End Sub

Private Sub Text3_GotFocus()
    Text3.SelStart = 0
    Text3.SelLength = Len(Text3)

End Sub

Private Sub Text4_GotFocus()
    Text4.SelStart = 0
    Text4.SelLength = Len(Text4)

End Sub

Private Sub Text5_GotFocus()
    Text5.SelStart = 0
    Text5.SelLength = Len(Text5)

End Sub

Private Sub Text8_Change()
    Option1(1).Value = True
End Sub