CQ ham radio - アマチュア無線の専門誌

<% 'Option Explicit ' RSSReader / CQ 1.00 2008/04/23 ' 1.01 2008/05/26 add USE_APPVAR ' < %= RSSReader(url, max, fmt, ctl) % > ←このように使う ' url : 取得したいRSSファイルのあるURL URLでないといけない ' max : 取得したい件数の最大値 (-1で無制限) ' fmt : 出力フォーマット ' ctl : 出力コントロール(絞込み/並び順) ' ' fmt: {title:100}
とか書く ' {name[:fmt]} name -> title, link, date, summary, num ' fmt: 文字列：先頭からｎ文字 ' 日付のときのみ、 YYYY MM DD HH NN SS が使える {date:MM-DD}とか ' 省略するとデフォルト有。VBなので"は重ねる("")こと ' ' ctl: ' 先頭1文字*で、日付順ソート ' それ以降は、タグの絞込条件 ' 無印は無条件に必要 ' +で追加条件 ' -で除外条件 ' カンマ区切りとする ' あと見つからない場合の文字列とか？ const CACHEFOLDER = "d:\rsscache\" ' キャッシュ用フォルダ const CACHETTL = 55 ' minutes const CACHEASPTTL = 60 const USE_APPVAR = true ' Application変数を利用するかしないかtrue/false Const TYPE_UNKNOWN = 0 Const TYPE_RDF = 1 ' rss0.9/1.0 Const TYPE_RSS = 2 ' rss0.91/0.92/2.0 Const TYPE_ATOM = 3 ' Atom Response.CacheControl = "no-cache" Response.AddHeader "Pragma", "no-cache" Response.Expires = -1 Response.Buffer = false Dim internal_RSSErrorFlag internal_RSSErrorFlag = false Function HTMLEncode(s) HTMLEncode = Server.HTMLEncode(s) End Function ' bubble sort ' 文字列、降順、先頭の19文字に日付時刻データとする Sub ArraySort(ByRef a) Dim i, j, tmp, CMPLEN ',ef CMPLEN = 19 ' Len("yyyy/mm/dd HH:NN:SS") For i = 0 To UBound(a) -1 ' Wscript.Echo i & "=" & a(i) ' ef = true For j = i + 1 To UBound(a) If Left(a(i), CMPLEN) < Left(a(j), CMPLEN) Then ' 入れ替える tmp = a(i) a(i) = a(j) a(j) = tmp ' ef = false End If Next ' If ef = true Then Exit For ' 入れ替えなしなら終了 Next End Sub ' md5関連 Function sl(ByVal x, ByVal n) ' 左シフト If n = 0 Then sl = x Else Dim k k = CLng(2 ^ (32 - n - 1)) Dim d d = x And (k - 1) Dim c c = d * CLng(2 ^ n) If x And k Then c = c Or &H80000000 End If sl = c End If End Function Function sr(ByVal x, ByVal n) ' 右シフト(算術(>>)ではなく論理(>>>)シフトに相当) If n = 0 Then sr = x Else Dim y y = x And &H7FFFFFFF Dim z If n = 32 - 1 Then z = 0 Else z = y \ CLng(2 ^ n) End If If y <> x Then z = z Or CLng(2 ^ (32 - n - 1)) End If sr = z End If End Function Function add(ByVal a, ByVal b) ' オーバフローを無視して 32 ビットの加算をおこなう。 If a >= 0 And b <= 0 Then add = a + b ElseIf a <= 0 And b >= 0 Then add = a + b Else Dim x x = a And &H3FFFFFFF Dim y y = b And &H3FFFFFFF Dim z z = x + y Dim f f = 0 If z And &H40000000 Then f = f + 1 End If z = z And &H3FFFFFFF If a And &H40000000 Then f = f + 1 End If If a And &H80000000 Then f = f + 2 End If If b And &H40000000 Then f = f + 1 End If If b And &H80000000 Then f = f + 2 End If If f And 1 Then z = z Or &H40000000 End If If f And 2 Then z = z Or &H80000000 End If add = z End If End Function Function addCur(ByVal a, ByVal b) ' オーバフローを無視して 32 ビットの加算をおこなう。 Dim c c = CCur(a) + CCur(b) If c > &H7FFFFFFF Then c = c - CCur(2 ^ 32) ElseIf c < &H80000000 Then c = c + CCur(2 ^ 32) End If addCur = CLng(c) End Function Function ba(ByVal s) ' 文字列を文字の配列に変換する。 Dim r If Len(s) = 0 Then ' 要素数が 0 個の配列のみ特別扱いする。 r = Array() Else ReDim a(Len(s) - 1) Dim i For i = 0 To Len(s) - 1 a(i) = Asc(Mid(s, i + 1, 1)) Next r = a End If ba = r End Function Function FX(ByVal x, ByVal y, ByVal z) FX = (x And y) Or ((Not x) And z) End Function Function GX(ByVal x, ByVal y, ByVal z) GX = (x And z) Or (y And (Not z)) End Function Function HX(ByVal x, ByVal y, ByVal z) HX = x Xor y Xor z End Function Function IX(ByVal x, ByVal y, ByVal z) IX = y Xor (x Or (Not z)) End Function Function ROTATE_LEFT(ByVal x, ByVal n) ROTATE_LEFT = sl(x, n) Or sr(x, 32 - n) End Function Sub FF(ByRef a, ByVal b, ByVal c, ByVal d, ByVal x, ByVal s, ByVal ac) a = add(add(add(a, FX(b, c, d)), x), ac) a = ROTATE_LEFT(a, s) a = add(a, b) End Sub Sub GG(ByRef a, ByVal b, ByVal c, ByVal d, ByVal x, ByVal s, ByVal ac) a = add(add(add(a, GX(b, c, d)), x), ac) a = ROTATE_LEFT(a, s) a = add(a, b) End Sub Sub HH(ByRef a, ByVal b, ByVal c, ByVal d, ByVal x, ByVal s, ByVal ac) a = add(add(add(a, HX(b, c, d)), x), ac) a = ROTATE_LEFT(a, s) a = add(a, b) End Sub Sub II(ByRef a, ByVal b, ByVal c, ByVal d, ByVal x, ByVal s, ByVal ac) a = add(add(add(a, IX(b, c, d)), x), ac) a = ROTATE_LEFT(a, s) a = add(a, b) End Sub Sub MD5Init(ByRef state, ByRef count, ByRef buffer) count(0) = 0 count(1) = 0 state(0) = &H67452301 state(1) = &HEFCDAB89 state(2) = &H98BADCFE state(3) = &H10325476 End Sub Sub MD5Update(ByRef state, ByRef count, ByRef buffer, ByRef inputx, ByVal inputLen) Dim i Dim index Dim partLen index = sr(count(0), 3) And &H3F count(0) = add(count(0), sl(inputLen, 3)) If count(0) < sl(inputLen, 3) Then count(1) = add(count(1), 1) End If count(1) = add(count(1), sr(inputLen, 29)) partLen = 64 - index If inputLen >= partLen Then Call MD5_memcpy(buffer, index, inputx, 0, partLen) Call MD5Transform(state, buffer, 0) For i = partLen To inputLen - 63 - 1 Step 64 Call MD5Transform(state, inputx, i) Next index = 0 Else i = 0 End If Call MD5_memcpy(buffer, index, inputx, i, inputLen - i) End Sub Sub MD5Final(ByRef digest, ByRef state, ByRef count, ByRef buffer) Dim bits(7) Dim index Dim padLen Call Encode(bits, count, 8) index = sr(count(0), 3) And &H3F If index < 56 Then padLen = 56 - index Else padLen = 120 - index End If Dim PADDING PADDING = Array( _ &H80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, _ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, _ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 _ ) Call MD5Update(state, count, buffer, PADDING, padLen) Call MD5Update(state, count, buffer, bits, 8) Call Encode(digest, state, 16) Dim i For i = 0 To UBound(state) state(i) = 0 Next For i = 0 To UBound(count) count(i) = 0 Next For i = 0 To UBound(buffer) buffer(i) = 0 Next End Sub Sub MD5Transform(ByRef state, ByRef block, ByVal offset) Dim a a = state(0) Dim b b = state(1) Dim c c = state(2) Dim d d = state(3) Dim x(15) Call Decode(x, block, offset, 64) ' Round 1 Call FF(a, b, c, d, x( 0), 7, &HD76AA478) ' 1 S11 Call FF(d, a, b, c, x( 1), 12, &HE8C7B756) ' 2 S12 Call FF(c, d, a, b, x( 2), 17, &H242070DB) ' 3 S13 Call FF(b, c, d, a, x( 3), 22, &HC1BDCEEE) ' 4 S14 Call FF(a, b, c, d, x( 4), 7, &HF57C0FAF) ' 5 S11 Call FF(d, a, b, c, x( 5), 12, &H4787C62A) ' 6 S12 Call FF(c, d, a, b, x( 6), 17, &HA8304613) ' 7 S13 Call FF(b, c, d, a, x( 7), 22, &HFD469501) ' 8 S14 Call FF(a, b, c, d, x( 8), 7, &H698098D8) ' 9 S11 Call FF(d, a, b, c, x( 9), 12, &H8B44F7AF) ' 10 S12 Call FF(c, d, a, b, x(10), 17, &HFFFF5BB1) ' 11 S13 Call FF(b, c, d, a, x(11), 22, &H895CD7BE) ' 12 S14 Call FF(a, b, c, d, x(12), 7, &H6B901122) ' 13 S11 Call FF(d, a, b, c, x(13), 12, &HFD987193) ' 14 S12 Call FF(c, d, a, b, x(14), 17, &HA679438E) ' 15 S13 Call FF(b, c, d, a, x(15), 22, &H49B40821) ' 16 S14 ' Round 2 Call GG(a, b, c, d, x( 1), 5, &HF61E2562) ' 17 S21 Call GG(d, a, b, c, x( 6), 9, &HC040B340) ' 18 S22 Call GG(c, d, a, b, x(11), 14, &H265E5A51) ' 19 S23 Call GG(b, c, d, a, x( 0), 20, &HE9B6C7AA) ' 20 S24 Call GG(a, b, c, d, x( 5), 5, &HD62F105D) ' 21 S21 Call GG(d, a, b, c, x(10), 9, &H2441453) ' 22 S22 Call GG(c, d, a, b, x(15), 14, &HD8A1E681) ' 23 S23 Call GG(b, c, d, a, x( 4), 20, &HE7D3FBC8) ' 24 S24 Call GG(a, b, c, d, x( 9), 5, &H21E1CDE6) ' 25 S21 Call GG(d, a, b, c, x(14), 9, &HC33707D6) ' 26 S22 Call GG(c, d, a, b, x( 3), 14, &HF4D50D87) ' 27 S23 Call GG(b, c, d, a, x( 8), 20, &H455A14ED) ' 28 S24 Call GG(a, b, c, d, x(13), 5, &HA9E3E905) ' 29 S21 Call GG(d, a, b, c, x( 2), 9, &HFCEFA3F8) ' 30 S22 Call GG(c, d, a, b, x( 7), 14, &H676F02D9) ' 31 S23 Call GG(b, c, d, a, x(12), 20, &H8D2A4C8A) ' 32 S24 ' Round 3 Call HH(a, b, c, d, x( 5), 4, &HFFFA3942) ' 33 S31 Call HH(d, a, b, c, x( 8), 11, &H8771F681) ' 34 S32 Call HH(c, d, a, b, x(11), 16, &H6D9D6122) ' 35 S33 Call HH(b, c, d, a, x(14), 23, &HFDE5380C) ' 36 S34 Call HH(a, b, c, d, x( 1), 4, &HA4BEEA44) ' 37 S31 Call HH(d, a, b, c, x( 4), 11, &H4BDECFA9) ' 38 S32 Call HH(c, d, a, b, x( 7), 16, &HF6BB4B60) ' 39 S33 Call HH(b, c, d, a, x(10), 23, &HBEBFBC70) ' 40 S34 Call HH(a, b, c, d, x(13), 4, &H289B7EC6) ' 41 S31 Call HH(d, a, b, c, x( 0), 11, &HEAA127FA) ' 42 S32 Call HH(c, d, a, b, x( 3), 16, &HD4EF3085) ' 43 S33 Call HH(b, c, d, a, x( 6), 23, &H4881D05) ' 44 S34 Call HH(a, b, c, d, x( 9), 4, &HD9D4D039) ' 45 S31 Call HH(d, a, b, c, x(12), 11, &HE6DB99E5) ' 46 S32 Call HH(c, d, a, b, x(15), 16, &H1FA27CF8) ' 47 S33 Call HH(b, c, d, a, x( 2), 23, &HC4AC5665) ' 48 S34 ' Round 4 Call II(a, b, c, d, x( 0), 6, &HF4292244) ' 49 S41 Call II(d, a, b, c, x( 7), 10, &H432AFF97) ' 50 S42 Call II(c, d, a, b, x(14), 15, &HAB9423A7) ' 51 S43 Call II(b, c, d, a, x( 5), 21, &HFC93A039) ' 52 S44 Call II(a, b, c, d, x(12), 6, &H655B59C3) ' 53 S41 Call II(d, a, b, c, x( 3), 10, &H8F0CCC92) ' 54 S42 Call II(c, d, a, b, x(10), 15, &HFFEFF47D) ' 55 S43 Call II(b, c, d, a, x( 1), 21, &H85845DD1) ' 56 S44 Call II(a, b, c, d, x( 8), 6, &H6FA87E4F) ' 57 S41 Call II(d, a, b, c, x(15), 10, &HFE2CE6E0) ' 58 S42 Call II(c, d, a, b, x( 6), 15, &HA3014314) ' 59 S43 Call II(b, c, d, a, x(13), 21, &H4E0811A1) ' 60 S44 Call II(a, b, c, d, x( 4), 6, &HF7537E82) ' 61 S41 Call II(d, a, b, c, x(11), 10, &HBD3AF235) ' 62 S42 Call II(c, d, a, b, x( 2), 15, &H2AD7D2BB) ' 63 S43 Call II(b, c, d, a, x( 9), 21, &HEB86D391) ' 64 S44 state(0) = add(state(0), a) state(1) = add(state(1), b) state(2) = add(state(2), c) state(3) = add(state(3), d) Dim i For i = 0 To UBound(x) x(i) = 0 Next End Sub Sub Encode(ByRef output, ByRef inputx, ByVal lenx) Dim i i = 0 Dim j j = 0 Do While j < lenx output(j) = inputx(i) And &HFF output(j + 1) = sr(inputx(i), 8) And &HFF output(j + 2) = sr(inputx(i), 16) And &HFF output(j + 3) = sr(inputx(i), 24) And &HFF i = i + 1 j = j + 4 Loop End Sub Sub Decode(ByRef output, ByRef inputx, ByVal inputxOffset, ByVal lenx) Dim i i = 0 Dim j j = 0 Do While j < lenx Dim k k = j + inputxOffset output(i) = inputx(k) Or sl(inputx(k + 1), 8) Or sl(inputx(k + 2), 16) Or sl(inputx(k + 3), 24) i = i + 1 j = j + 4 Loop End Sub Sub MD5_memcpy(ByRef output, ByVal outputOffset, ByRef inputx, ByVal inputxOffset, ByVal lenx) Dim i For i = 0 To lenx - 1 output(i + outputOffset) = inputx(i + inputxOffset) Next End Sub 'Function main(ByVal argc, ByRef argv) ' Dim i ' If argc > 1 Then ' For i = 1 To argc - 1 ' If Mid(argv(i), 1, 2) = "-s" Then ' Call MDString(Mid(argv(i), 3)) ' ElseIf argv(i) = "-t" Then ' ' Call MDTimeTrial ' ElseIf argv(i) = "-x" Then ' Call MDTestSuite ' Else ' ' Call MDFile(argv(i)) ' End If ' Next ' Else ' ' Call MDFilter ' End If ' main = 0 'End Function Function MDString(ByVal stringx) Dim state(3) Dim count(1) Dim buffer(63) Dim digest(15) Dim lenx lenx = Len(stringx) Call MD5Init(state, count, buffer) Call MD5Update(state, count, buffer, ba(stringx), lenx) Call MD5Final(digest, state, count, buffer) Dim s s = MDPrint(digest) MDString = s End Function 'Sub MDTestSuite() ' Dim x ' Dim y ' Dim r ' r = "" ' ' x = "" ' y = MDString(x) ' r = r & x & ": " & y & vbNewLine ' ' x = "a" ' y = MDString(x) ' r = r & x & ": " & y & vbNewLine ' ' x = "abc" ' y = MDString(x) ' r = r & x & ": " & y & vbNewLine ' ' x = "message digest" ' y = MDString(x) ' r = r & x & ": " & y & vbNewLine ' ' x = "abcdefghijklmnopqrstuvwxyz" ' y = MDString(x) ' r = r & x & ": " & y & vbNewLine ' ' x = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" ' y = MDString(x) ' r = r & x & ": " & y & vbNewLine ' ' x = "12345678901234567890123456789012345678901234567890123456789012345678901234567890" ' y = MDString(x) ' r = r & x & ": " & y & vbNewLine ' ' Call MsgBox(r) 'End Sub Function MDPrint(ByRef digest) Dim s s = "" Dim i For i = 0 To 16 - 1 s = s & Right("00" & LCase(Hex(digest(i))), 2) Next MDPrint = s End Function ' Call main(2, Array("", "-x")) ' RSS1.0 ' rdf:RDF xmlns="http://purl.org/rss/1.0" ' channel ' title ' link ' description ' items ' rdf:Seq ' rdf:li + ' item + ' title ' link ' description ? ' dc:date (YYYY-MM-DDThh:mm) ' ' RSS0.9 ' rdf:RDF xmlns="http://my.netscape.com/rdf/simple/0.9/" ' channel ' title ' description ' link ' image ? ' title ' url ' link ' item + ' title ' link ' textinput ? ' title ' description ' name ' link 'RSS0.91/0.92 もう無い？というかぜんぜん別物 itemの階層が違う 'rss version="0.91" or version="0.92" ' channel ' title ' description ' link ' language ' item+ ' title ' link ' description ' rating? ' ... 'RSS2.0 'rss version="2.0" ' channel ' title,link,description,... ' item+ ' title ' description ' link ' pubDate ' category ' ' Atom 'feed xmlns="http://www.w3.org/2005/Atom ' title ' subtitle ' id ' link ' author ' name ' updated ' entry + ' title ' link ' id ' author ' published ' updated ' category ' summary ' content ' 時刻の扱いRFCなど 'W3CDTF ' YYYY ' YYYY-MM ' YYYY-MM-DD ' YYYY-MM-DDThh:mmTZD ' YYYY-MM-DDThh:mm:ssTZD ' YYYY-MM-DDThh:mm:ss.sTZD TZD = "+09:00" とか "Z"とか '基本的にこれだが、RSS2.0のpubDateのみRFC822の日付 '5.1 SYNTAX ' date-time = [ day "," ] date time ; dd mm yy ' ; hh:mm:ss zzz ' day = "Mon" / "Tue" / "Wed" / "Thu" ' / "Fri" / "Sat" / "Sun" ' date = 1*2DIGIT month 2DIGIT ; day month year ' ; e.g. 20 Jun 82 ' month = "Jan" / "Feb" / "Mar" / "Apr" ' / "May" / "Jun" / "Jul" / "Aug" ' / "Sep" / "Oct" / "Nov" / "Dec" ' time = hour zone ; ANSI and Military ' hour = 2DIGIT ":" 2DIGIT [":" 2DIGIT] ' ; 00:00:00 - 23:59:59 ' zone = "UT" / "GMT" ; Universal Time ' ; North American : UT ' / "EST" / "EDT" ; Eastern: - 5/ - 4 ' / "CST" / "CDT" ; Central: - 6/ - 5 ' / "MST" / "MDT" ; Mountain: - 7/ - 6 ' / "PST" / "PDT" ; Pacific: - 8/ - 7 ' / 1ALPHA ; Military: Z = UT; ' ; A:-1; (J not used) ' ; M:-12; N:+1; Y:+12 ' / ( ("+" / "-") 4DIGIT ) ; Local differential ' ; hours+min. (HHMM) ' ' 2バイト文字1文字をを2文字としてカウントするLeft関数 ' なんとなく正確ではないが桁そろえをしたいので Function LeftJ(s, n) Dim count Dim c, l, i l = 0 If(Len(s)*2 < n) Then LeftJ = s Exit Function End If For i = 1 to Len(s) c = Asc(Mid(s, i, 1)) If (c >= 0) and (c <= 255) Then l = l + 1 Else l = l + 2 End If If l >= n Then LeftJ = Left(s, i) Exit Function End If Next LeftJ = s End Function ' HTMLからタグを除外する改行も消す連続するスペースも消す Function GetTextOnly(s) Dim r, re r = GetTextFromHTML(s) r = Replace(r, vbCrlf, " ") r = Replace(r, vbCr, " ") r = Replace(r, vblf, " ") Set re = New RegExp re.Pattern = "([\s　]+)" re.IgnoreCase = true re.Global = true r = re.Replace(r, " ") GetTextOnly = r End Function ' ------------------------------------------------------------------------- ' HTML文から、タグを取り除いたテキスト部分を取得する Function GetTextFromHTML(ss) Dim s Dim i, p Dim c, code Dim result Dim InTag, InComment i = 1 ' i は文字位置 s = ss InTag = false ' タグ内フラグ InComment = false ' コメント内フラグ ' 結果文字列 result = "" ' NULL の時の対応 If(Len(s) = 0) Then GetTextFromHTML = "" Exit Function End If ' 1文字ずつ処理 Do While i <= Len(s) c = mid(s, i, 1) i = i + 1 code = asc(c) If InComment Then If(c = "-") Then If(mid(s, i, 3) = "-->") Then InComment = false i = i + 2 End If End If ElseIf InTag Then If(c = ">") Then InTag = false End If Else If(c = "<") Then If(mid(s, i , 4) = "" & s Else Application.Lock Application.Contents.Remove(datename) Application.Contents.Remove(dataname) Application.Unlock s = "" & s End If 'Application.Contents("dummy") = 0 'Application.Unlock Call DeleteOldItems(allpara) RSSReader = s Exit Function End If Application.Lock dt1 = Application.Contents(datename) If (IsDate(dt1) = false) or (DateAdd("n", CACHEASPTTL, dt1) < Now) Then Application.Contents(datename) = Now Application.Unlock ' cache timed out s = InternalRSSReader2(url, max, fmt, ctl) If internal_RSSErrorFlag = false Then Application.Lock Application.Contents(datename) = Now Application.Contents(dataname) = s Application.Unlock s = "" & s Else Application.Lock Application.Contents.Remove(datename) Application.Contents.Remove(dataname) Application.Unlock s = "" & s End If ' RSSReader = s ' Exit Function ' s = "" & s ' 古くて使わなくなった値があれば削除する Call DeleteOldItems(allpara) Else s = "" & Application.Contents(dataname) Application.Unlock End If RSSReader = s End Function 'url = "http://www.eleki-jack.com/news/index.xml" 'url = url & "," & "http://www.eleki-jack.com/KitsandKids2/index.xml" 'WScript.Echo RSSReader(url, 10, "{num}.{title:50.}
{summary:100.}
", "LEDファン,GPS") 'WScript.Echo RSSReader2(url, -1, "{date:MM-DD HH:NN}
・{title:50.}
{summary:50.}
", "*LEDファン,ニュース") 'WScript.Echo RSSReader2(url, -1, "{date:MM-DD HH:NN}
・{title}
{summary:100.}
", "ニュース") 'WScript.Quit %> CQ ham radio - アマチュア無線の専門誌

<%= RSSReader("http://www.cqhamradio.jp/index.xml", 5, "{date:MM/DD}　{title:24.}
", "") %>

9月号
8月19日発売
特別号定価930円

別冊付録
CQ ham radioオリジナル・ログブック

　　

[　総務省　]

　　http://www.tele.soumu.go.jp/
■ 総務省電波利用電子申請・届出システムLite
　　http://www.denpa.soumu.go.jp/public2/index.html
■ 関東総合通信局　　　http://www.kanto-bt.go.jp/
　　TEL：03-6238-1940
■ 東海総合通信局　　　http://www.tokai-bt.soumu.go.jp/
　　TEL：052-971-9104
■ 近畿総合通信局　　　http://www.ktab.go.jp/
　　TEL：06-6942-8564
■ 中国総合通信局　　　http://www.cbt.go.jp/
　　TEL：082-222-3369
■ 四国総合通信局　　　http://www.shikoku-bt.go.jp/
　　TEL：089-936-5011
■ 九州総合通信局　　　http://www.kbt.go.jp/
　　TEL：096-326-7819
■ 沖縄総合通信事務所　　　http://www.okinawa-bt.soumu.go.jp/
　　TEL：098-865-2390
■ 東北総合通信局　　　http://www.ttb.go.jp/
　　TEL：022-221-0610
■ 北海道総合通信局　　　http://www.hokkaido-bt.go.jp/
　　TEL：011-709-3550
■ 北陸総合通信局　　　http://www.hokuriku-bt.go.jp/
　　TEL：076-233-4405
■ 信越総合通信局　　　http://www.shinetsu-bt.go.jp/
　　TEL：026-234-9961

[　（財）日本無線協会　]

　 http://www.nichimu.or.jp/
■（財）日本無線協会本部
　　TEL：03-3533-6022，03-3533-6821
■（財）日本無線協会東海支部
　　TEL：052-951-2589
■（財）日本無線協会近畿支部
　　TEL：06-6942-0420
■（財）日本無線協会中国支部
　　TEL：082-227-5253，082-227-2191
■（財）日本無線協会四国支部
　　TEL：089-946-4431
■（財）日本無線協会九州支部
　　TEL：096-356-7902
■（財）日本無線協会沖縄支部
　　TEL：098-831-9001
■（財）日本無線協会東北支部
　　TEL：022-221-4146
■（財）日本無線協会北海道支部
　　TEL：011-271-6060
■（財）日本無線協会北陸支部
　　TEL：076-222-7121
■（財）日本無線協会信越支部
　　TEL：026-234-1377
■ 無線従事者国家試験申請システム
　　https://shinsei.nichimu.or.jp/
　　

[　日本アマチュア無線連盟（JARL）　]

　　http://www.jarl.or.jp/
■ 会員事業課
　　TEL：03-5395-3109　FAX：03-5395-3134
■ 業務課
　　TEL：03-5395-3112　FAX：03-5395-3134
■ 非常通信センター
　　TEL：03-5395-3112　FAX：03-5395-3134
■ 国際課
　　TEL：03-5395-3106　FAX：03-3943-8282
■ 広報課
　　TEL：03-5395-3119　FAX：03-3943-3134

[　日本アマチュア無線振興協会（JARD）養成部　]

　　http://www.jard.or.jp/
　　TEL：03-3910-7210

[　日本アマチュア無線機器工業会（JAIA）　]

　　http://www.jaia.or.jp/
　　TEL：03-3944-8611　FAX：03-3946-1186

[　TSS（株）保証事業部　]

　　http://www.tsscom.co.jp/
　　TEL：03-5976-6411　FAX：03-5976-6412