カテゴリー
PHP VBA

ドメインが利用可能かチェックするPHPスクリプト

ドメイン名が利用可能かチェックするのに dns_get_record 関数を使います。
パラメータには url か domain.com のようなドメイン名
結果はテキストで OK か NG を返します。

<?php
$url = $_GET["url"];
$res = parse_url($url);
$name = "";

if (isset($res['host'])) {
    $name = $res['host'];
} else if (isset($res['path'])) {
    $name = $res['path'];
}

header('Content-type: plain/text');
if (!empty($name)) {
    $result = dns_get_record($name);
    if ($result === false || empty($result)) {
        echo 'NG';
    } else {
        echo 'OK';
    }
} else {
    echo 'ERR';
}
exit;
?>

このPHPスクリプトをエクセルVBAから呼び出す例:

'
' ドメインチェック WebAPI
'
'   URL: https://www.northwind.mydns.jp/samples/webservice/checkdomain.php
'   パラメータ: url
'   レスポンス:
'        OK: 利用可能
'        NG: 利用不可
'
' Ex.
'  IsDomainAvailable("northwind.mydns.jp")        = True
'
'
Function IsDomainAvailable(DomainUrl As String) As Boolean
    On Error GoTo ErrHandler

    Dim Request As Object
    Dim checkerUrl As String

    IsDomainAvailable = False
    checkerUrl = "https://www.northwind.mydns.jp/samples/webservice/checkdomain.php"

    Set Request = CreateObject("WinHttp.WinHttpRequest.5.1")

    With Request
      .Open "GET", checkerUrl & "?url=" & DomainUrl, False
      .send

        If .StatusText = "OK" And .ResponseText = "OK" Then
            IsDomainAvailable = True
        End If
    End With

    Set Request = Nothing
    
    Exit Function
ErrHandler:
    Debug.Print Err.Number & ": " & Err.Description
End Function

Sub Test()

    Debug.Print IsDomainAvailable("northwind.mydns.jp")

End Sub
カテゴリー
VBA

マイナンバーのチェックデジットをVBAで算出

個人用マイナンバーのチェックデジットをVBAで算出してみました。

参考までに。。。

' https://law.e-gov.go.jp/announce/H26F11001000085.html
'
' (検査用数字を算出する算式)
' 第五条 令第八条の総務省令で定める算式は、次に掲げる算式とする。
' 算式
'  11―(n=1(シグマ)11(Pn×Qn))を11で除した余り)
'  ただし、(n=1(シグマ)11(Pn×Qn))を11で除した余り≦1の場合は、0とする。
' 算式の符号
'   Pn 個人番号を構成する検査用数字以外の十一桁の番号の最下位の桁を1桁目としたときのn桁目の数字
'  Qn 1≦n≦6のとき n+1 7≦n≦11のとき n―5
'
Function CalcCheckDigit(number As String) As Integer
    Dim digits As String
    Dim chkDigit As String
    Dim cd As Integer
    
    cd = -1

    ' 12桁でなければ無効
    If Len(number) <> 12 Then
        CalcCheckDigit = cd
        Exit Function
    End If
    
    ' チェックデジット部分を取出し
    chkDigit = Right(number, 1)
    
    ' マイナンバー11桁取出し
    digits = Left(number, 11)
    
    Dim n, pn, qn, m As Long
    Dim sum As Long
    
    res = False
    sum = 0
    
    For n = 1 To 11
        ' n桁目の数字
        ' 小さい桁から計算(検査用数字以外の十一桁の番号の最下位の桁を1桁目)
        pn = CInt(Mid(digits, 11 - n + 1, 1))
        
        ' 1≦n≦6のときn+1
        If n <= 6 Then
            qn = n + 1
        ' 7≦n≦11のときn―5
        Else
            qn = n - 5
        End If
        
        sum = sum + pn * qn
    Next
    
    ' 11 で割った余り
    m = sum Mod 11

    ' (n=1(シグマ)11(Pn×Qn))を11で除した余り≦1の場合は、0とする
    If m <= 1 Then
        cd = 0
    ' 11―(n=1(シグマ)11(Pn×Qn))を11で除した余り)
    Else
        cd = 11 - m
    End If

    CalcCheckDigit = cd
End Function

ためしに自分のマイナンバーで計算してみると合っていました。^_^;

参考サイト:
https://qiita.com/qube81/items/fa6ef94d3c8615b0ce64

カテゴリー
VBA

Access フォームのウィンドウサイズ調整

Access のフォームを開いたときに、最大化ではなくてAccess のクライアント領域のサイズで開きたいのですが、意外に難しかったです。あるフォームの Form_Open イベントで FormAutoResizing を呼ぶとクライアント領域のサイズに合わせて表示できます。

Private Sub Form_Open(Cancel As Integer)
    ' ウィンドウの大きさ自動調整
    FormAutoResizing
End Sub
' ウィンドウサイズ調整
Public ResWidth As String
Public ResHeight As String

Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, rectangle As RECT) As Long
Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Type RECT
   x1 As Long
   y1 As Long
   x2 As Long
   y2 As Long
End Type

'
' https://support.microsoft.com/en-us/kb/94927?wa=wsignin1.0
'
Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Const HWND_DESKTOP As Long = 0
Const LOGPIXELSX As Long = 88
Const LOGPIXELSY As Long = 90

'--------------------------------------------------
Function PixelXToTwips(pixelsx As Long) As Single
    Dim lngDC As Long
    lngDC = GetDC(HWND_DESKTOP)
    PixelXToTwips = pixelsx * 1440& / GetDeviceCaps(lngDC, LOGPIXELSX)
    ReleaseDC HWND_DESKTOP, lngDC
End Function

'--------------------------------------------------
Function PixelYToTwips(pixelsy As Long) As Single
    Dim lngDC As Long
    lngDC = GetDC(HWND_DESKTOP)
    PixelYToTwips = pixelsy * 1440& / GetDeviceCaps(lngDC, LOGPIXELSY)
    ReleaseDC HWND_DESKTOP, lngDC
End Function
            


Public Function FormAutoResizing()
    Dim ret As Long
    Dim rc As RECT
    Dim w As Integer
    Dim h As Integer
    
    Dim hWnd As Long
    ' Access のクライアント領域を検索
    hWnd = FindWindowEx(Application.hWndAccessApp, 0, "MDIClient", vbNullString)
    If hWnd = 0 Then
        hWnd = Application.hWndAccessApp
    End If
    
    ret = GetClientRect(hWnd, rc)

    If ret Then
        w = PixelXToTwips(rc.x2 - rc.x1)
        h = PixelYToTwips(rc.y2 - rc.y1)
        DoCmd.MoveSize 0, 0, w, h
    End If
End Function