shikaku's blog (original) (raw)

StartWebServer()でスタートして
StopWebServer()で止めます。

Option Explicit

#If VBA7 Then Private Declare PtrSafe Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Long, lpWSAData As Any) As Long Private Declare PtrSafe Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As LongPtr Private Declare PtrSafe Function bind Lib "ws2_32.dll" (ByVal s As LongPtr, ByRef name As SOCKADDR_IN, ByVal namelen As Long) As Long Private Declare PtrSafe Function listen Lib "ws2_32.dll" (ByVal s As LongPtr, ByVal backlog As Long) As Long Private Declare PtrSafe Function accept Lib "ws2_32.dll" (ByVal s As LongPtr, ByRef addr As SOCKADDR_IN, ByRef addrLen As Long) As LongPtr Private Declare PtrSafe Function recv Lib "ws2_32.dll" (ByVal s As LongPtr, ByVal buf As String, ByVal llen As Long, ByVal flags As Long) As Long Private Declare PtrSafe Function send Lib "ws2_32.dll" (ByVal s As LongPtr, ByVal buf As String, ByVal llen As Long, ByVal flags As Long) As Long Private Declare PtrSafe Function closesocket Lib "ws2_32.dll" (ByVal s As LongPtr) As Long Private Declare PtrSafe Function WSACleanup Lib "ws2_32.dll" () As Long Private Declare PtrSafe Function ioctlsocket Lib "ws2_32.dll" (ByVal s As LongPtr, ByVal cmd As Long, ByRef argp As Long) As Long Private Declare PtrSafe Function WSAGetLastError Lib "ws2_32.dll" () As Long #Else Private Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Long, lpWSAData As Any) As Long Private Declare Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long Private Declare Function bind Lib "ws2_32.dll" (ByVal s As Long, ByRef name As SOCKADDR_IN, ByVal namelen As Long) As Long Private Declare Function listen Lib "ws2_32.dll" (ByVal s As Long, ByVal backlog As Long) As Long Private Declare Function accept Lib "ws2_32.dll" (ByVal s As Long, ByRef addr As SOCKADDR_IN, ByRef addrLen As Long) As Long Private Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As String, ByVal llen As Long, ByVal flags As Long) As Long Private Declare Function send Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As String, ByVal llen As Long, ByVal flags As Long) As Long Private Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long Private Declare Function WSACleanup Lib "ws2_32.dll" () As Long Private Declare Function ioctlsocket Lib "ws2_32.dll" (ByVal s As Long, ByVal cmd As Long, ByRef argp As Long) As Long Private Declare Function WSAGetLastError Lib "ws2_32.dll" () As Long #End If

Private Type SOCKADDR_IN sin_family As Integer sin_port As Integer sin_addr As Long sin_zero(0 To 7) As Byte End Type

Private Type wsaData wVersion As Integer wHighVersion As Integer szDescription(0 To 256) As Byte szSystemStatus(0 To 128) As Byte iMaxSockets As Integer iMaxUdpDg As Integer lpVendorInfo As Long End Type

Const AF_INET = 2 Const SOCK_STREAM = 1 Const INADDR_ANY = 0 Const SOCKET_ERROR = -1 Const FIONBIO = &H8004667E Const WSAEWOULDBLOCK = 10035

#If VBA7 Then Private serverRunning As Boolean Private serverSocket As LongPtr #Else Private serverRunning As Boolean Private serverSocket As Long #End If

' デバッグ用の変数 Private acceptCallCount As Long Private lastAcceptError As Long

Sub StartWebServer() Dim wsaData As wsaData Dim serverAddr As SOCKADDR_IN Dim nonBlocking As Long

' Initialize Winsock
If WSAStartup(&H202, wsaData) <> 0 Then
    MsgBox "Failed to initialize Winsock"
    Exit Sub
End If

' Create socket
serverSocket = socket(AF_INET, SOCK_STREAM, 0)
If serverSocket = SOCKET_ERROR Then
    MsgBox "Failed to create socket"
    WSACleanup
    Exit Sub
End If

' Set socket to non-blocking mode
nonBlocking = 1
If ioctlsocket(serverSocket, FIONBIO, nonBlocking) = SOCKET_ERROR Then
    MsgBox "Failed to set non-blocking mode"
    closesocket serverSocket
    WSACleanup
    Exit Sub
End If

' Bind socket
With serverAddr
    .sin_family = AF_INET
    .sin_port = htons(123456)
    .sin_addr = INADDR_ANY
End With

If bind(serverSocket, serverAddr, LenB(serverAddr)) = SOCKET_ERROR Then
    Dim bindError As Long
    bindError = WSAGetLastError()
    MsgBox "Failed to bind socket. Error code: " & bindError
    closesocket serverSocket
    WSACleanup
    Exit Sub
End If

' Listen for connections
If listen(serverSocket, 1) = SOCKET_ERROR Then
    MsgBox "Failed to listen on socket"
    closesocket serverSocket
    WSACleanup
    Exit Sub
End If

' デバッグ用の変数を初期化
acceptCallCount = 0
lastAcceptError = 0

MsgBox "Server started. Access http://127.0.0.1:123456/hogehoge in your browser."

serverRunning = True

' Schedule the first server check
Application.OnTime Now + TimeValue("00:00:01"), "CheckServerStatus"

End Sub

Sub CheckServerStatus() If Not serverRunning Then closesocket serverSocket WSACleanup MsgBox "Server stopped." Exit Sub End If

#If VBA7 Then
    Dim clientSocket As LongPtr
#Else
    Dim clientSocket As Long
#End If
Dim clientAddr As SOCKADDR_IN
Dim addrLen As Long
Dim recvBuf As String * 1024
Dim response As String
Dim bytesReceived As Long
Dim lastError As Long

addrLen = LenB(clientAddr)
clientSocket = accept(serverSocket, clientAddr, addrLen)

' accept呼び出し回数をインクリメント
acceptCallCount = acceptCallCount + 1

If clientSocket <> SOCKET_ERROR Then
    bytesReceived = recv(clientSocket, recvBuf, 1024, 0)
    If bytesReceived > 0 Then
        If InStr(1, recvBuf, "GET /kabucom") > 0 Then
            response = "HTTP/1.1 200 OK" & vbCrLf & _
                       "Content-Type: text/html" & vbCrLf & _
                       "Connection: close" & vbCrLf & vbCrLf & _
                       "<html><body><h1>Hello World</h1></body></html>"
            send clientSocket, response, Len(response), 0
        End If
    End If
    closesocket clientSocket
Else
    lastError = WSAGetLastError()
    If lastError <> WSAEWOULDBLOCK Then
        ' エラー情報を更新
        lastAcceptError = lastError
        ' より詳細なエラー情報を表示
        MsgBox "Error accepting connection: " & lastError & vbCrLf & _
               "Accept calls: " & acceptCallCount & vbCrLf & _
               "Last error: " & lastAcceptError
    End If
End If

' Schedule the next check
Application.OnTime Now + TimeValue("00:00:01"), "CheckServerStatus"

End Sub

Private Function htons(ByVal hostshort As Integer) As Integer htons = ((hostshort And &HFF) * 256) + ((hostshort And &HFF00) \ 256) End Function

Sub StopWebServer() serverRunning = False End Sub

解説

簡易的なHTTPサーバーの構築の仕組みを、主要なステップに分けて説明します:

・ソケットの初期化と設定:

WSAStartup関数でWinsock APIを初期化します。
socket関数で新しいソケットを作成します。
ioctlsocket関数でソケットを非ブロッキングモードに設定します。

・ポートのバインドとリスニング:

bind関数で、作成したソケットを特定のIPアドレスとポート番号(ここでは12321)にバインドします。
listen関数で、ソケットを接続待ち状態にします。

・クライアント接続の受け付け:

CheckServerStatus サブルーチン内で、accept関数を使用してクライアントからの接続を受け付けます。
非ブロッキングモードのため、接続がない場合はすぐに制御を返します。

・リクエストの処理:

接続が確立したら、recv関数でクライアントからのHTTPリクエストを受信します。
リクエスト内容を解析し、"/hogehoge"へのGETリクエストかどうかを確認します。

・レスポンスの送信:

適切なHTTPレスポンスヘッダーとHTMLコンテンツを構築します。
send関数を使用して、構築したレスポンスをクライアントに送信します。

・接続のクローズ:

レスポンス送信後、closesocket関数でクライアントとの接続を閉じます。

繰り返し処理:

Application.OnTimeを使用して、次のCheckServerStatusの呼び出しをスケジュールし、
新しい接続を継続的にチェックします。

この仕組みにより、ExcelのVBA環境内で基本的なHTTPサーバー機能を実現しています。ただし、この実装は単純化されており、本格的なWebサーバーに比べると機能や性能、セキュリティ面で制限があります。

Discordボットトークンを入手する手順

ブラウザで https://discord.com/developers/applications にアクセスします。

右上の「New Application」ボタンをクリックします。
アプリケーション名を入力し、「Create」をクリックします。

左側のメニューから「Bot」を選択します。
「Add Bot」ボタンをクリックし、確認ダイアログで「Yes, do it!」を選択します。

必要に応じてボットの名前やアイコンを設定します。

「Token」セクションの「Copy」ボタンをクリックしてトークンをコピーします。
注意: このトークンは秘密にしておく必要があります。

「Privileged Gateway Intents」セクションで、ボットに必要な権限(例:メッセージ内容の読み取りなど)を有効にします。

左側のメニューから「OAuth2」→「URL Generator」を選択します。
「Scopes」で「bot」にチェックを入れ、必要な権限を選択します。
生成されたURLをコピーし、新しいブラウザタブで開きます。
ボットを追加したいサーバーを選択し、認証を完了します。

コピーしたトークンを、先ほどのPythonコードのTOKEN変数に貼り付けます。

注意点:

これらの手順に従えば、Discordボットのトークンを取得し、プログラムで使用することができます。

注意点:

これらの手順に従えば、BotをDiscordサーバーに正常に追加できるはずです。追加後、Botが期待通りに動作しない場合は、権限設定を再確認するか、Botのコードやトークンが正しいことを確認してください。

1分に1回、タスクスケジューラ等で呼ぶこと前提。

import asyncio from datetime import datetime, timedelta import pytz import requests from bs4 import BeautifulSoup import discord import aiohttp

Discordボットのトークン

DISCORD_TOKEN = 'Discordボットのトークン' CHANNEL_ID = '投稿したいチャンネルのID' def parse_time(date_str, time_str): try: # 日付と時間を結合 datetime_str = f"{date_str} {time_str}" # 26:00 のような表記を処理 if ':' in time_str: hours, minutes = map(int, time_str.split(':')) if hours >= 24: date_obj = datetime.strptime(date_str, "%m/%d") date_obj += timedelta(days=1) hours -= 24 datetime_str = f"{date_obj.strftime('%m/%d')} {hours:02d}:{minutes:02d}"

    event_date = datetime.strptime(datetime_str, "%m/%d %H:%M")
    event_date = event_date.replace(year=datetime.now().year)
    return pytz.timezone('Asia/Tokyo').localize(event_date)
except ValueError as e:
    print(f"Error parsing date/time: {e} for {date_str} {time_str}")
    return None

async def get_hirose_events(): url = "https://hirose-fx.co.jp/contents/ecclndr/" headers = { 'User-Agent': 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/91.0.4472.124 Safari/537.36' } async with aiohttp.ClientSession() as session: async with session.get(url, headers=headers) as response: print(f"Status Code: {response.status}") html_content = await response.text() print(f"Content length: {len(html_content)}")

soup = BeautifulSoup(html_content, 'html.parser')

events = []
rows = soup.select('table.layout-top.row-data.font-small tr')

current_date = None
for row in rows:
    cells = row.select('td')
    if len(cells) >= 6:
        date_cell = cells[0].text.strip()
        time = cells[1].text.strip()
        currency = cells[2].find('img')['title'] if cells[2].find('img') else ''
        event_name = cells[3].text.strip()

        if date_cell:
            current_date = date_cell.split()[0]

        if current_date and time and currency in ['日本', '米国']:
            event_date = parse_time(current_date, time)
            if event_date:
                events.append({
                    "name": f"{currency} - {event_name}",
                    "time": event_date
                })

print(f"Total JPY and USD events found: {len(events)}")
return events

async def report_upcoming_events(): fx_events = await get_hirose_events() now = datetime.now(pytz.timezone('Asia/Tokyo')) target_time = now + timedelta(minutes=30) upcoming_events = []

for event in fx_events:
    time_until_event = event['time'] - now
    if timedelta(minutes=29) <= time_until_event <= timedelta(minutes=30):
        upcoming_events.append(event)

if upcoming_events:
    message = "30分後に予定されている日本と米国のイベント:\n"
    for event in upcoming_events:
        message += f"{event['time'].strftime('%Y-%m-%d %H:%M')} - {event['name']}\n"

    # Discordに接続してメッセージを送信
    client = discord.Client(intents=discord.Intents.default())

    @client.event
    async def on_ready():
        try:
            channel = await client.fetch_channel(CHANNEL_ID)
            await channel.send(message)
            print(f"Message sent to channel {CHANNEL_ID}")
        finally:
            await client.close()

    await client.start(DISCORD_TOKEN)
else:
    print("No events scheduled in the next 30 minutes.")

async def main(): await report_upcoming_events()

if name == "main": asyncio.run(main())

void SetDateFromYYYYMMDD(CDateTimeCtrl& dateTimeCtrl, int yyyymmdd) { COleDateTime date; int year = yyyymmdd / 10000; int month = (yyyymmdd % 10000) / 100; int day = yyyymmdd % 100;

date.SetDate(year, month, day);
dateTimeCtrl.SetTime(date);

}

// 使用例 SetDateFromYYYYMMDD(m_date, 20240923);

日付に応じたリダイレクト