この上記二点のソフトです。 ちなみに文の中にクリスタEXが登場しますがこちらはCLIP STUDIO PAINT PROをバージョンアップさせたCLIP STUDIO PAINT EX というソフトです。こちらはPROよりも更に漫画作成に特化しているタイプのものでPROの仕様に加え様々なシステムが加わったソフトとなっております。 それでは続いていってみましょう。
BOMとは、バイト・オーダー・マーク(Byte order mark)の略で、Unicodeの符号化形式で符号化したテキストの先頭に着ける数バイトのデータのことです。 ExcelはCSVファイルを開くときデフォルトでShift-JISで開きに行ってしまいUTF-8では確実に文字化けしてしまいます。ですがUTF-8で出力する際にこのBOMを付けることでExcelにUTF-8で書かれていると認識させることができます。
Const adTypeBinary = 1
Const adTypeText = 2
Const adBTypeContent = 1
Const adBTypeBody = 2
Const adBTypeFooter = 3
Public Function UploadFile() As Boolean
Dim FilePath As String: FilePath = "d:\証明写真サンプル.jpg"
Dim strMethod As String: strMethod = "POST"
Dim strUri As String: strUri = "http://localhost"
Dim strResult As String
'---------------------------------
' リクエストパラメタ用の領域を生成
'---------------------------------
Dim tempParamStream As Object
Set tempParamStream = CreateObject("ADODB.Stream")
tempParamStream.Open
'---------------------------------
' リクエストパラメタ作成
'---------------------------------
Dim FileName As String
FileName = Dir(FilePath)
Dim JsonObject As Object
Set JsonObject = New Dictionary
JsonObject.Add "name", FileName
JsonObject.Add "parent", New Dictionary
JsonObject("parent").Add "id", 0
If SetNomarlParameter(tempParamStream, "attributes", JsonConverter.ConvertToJson(JsonObject)) Then
End If
If SetFileParmater(tempParamStream, "file", FilePath, "application/octet-stream") Then
End If
If SetEndParameter(tempParamStream) Then
End If
'---------------------------------
' リクエストパラメタ取得
'---------------------------------
Dim snedParameter As Variant
GetSendParameter snedParameter, tempParamStream
'---------------------------------
' リクエスト
'---------------------------------
Dim objHTTP As Object
Set objHTTP = CreateObject("msxml2.xmlhttp")
objHTTP.Open strMethod, strUri, False
objHTTP.setRequestHeader "Content-Type", "multipart/form-data; boundary=" + getBoundy(adBTypeContent)
objHTTP.send snedParameter
statusCode = objHTTP.status
strResult = StrConv(objHTTP.responsebody, vbUnicode)
Set objHTTP = Nothing
UploadFile = True
End Function
②データフォームのパラメタ設定
Private Function SetNomarlParameter( _
ByRef tempParamStream As Object, _
ByVal fname As String, _
ByVal fvalue As String) As Boolean
If fvalue <> "" Then
ChangeStreamType tempParamStream, adTypeText
Dim params As String
params = ""
params = params + getBoundy(adBTypeBody)
params = params + "Content-Disposition: form-data; name=""" + fname + """" + vbCrLf
params = params + vbCrLf
params = params + fvalue + vbCrLf
tempParamStream.WriteText params
End If
SetNomarlParameter = True
End Function
③ファイル（バイナリデータ）のパラメタ設定
Private Function SetFileParmater( _
ByRef tempParamStream As Object, _
ByVal fname As String, _
ByVal fvalue As String, _
ByVal fct As String) As Boolean
'-------------------------------------
' テキストデータ
'-------------------------------------
ChangeStreamType tempParamStream, adTypeText
Dim params As String
params = ""
params = params + getBoundy(adBTypeBody)
params = params + "Content-Disposition: form-data; name=""" + fname + """; filename=""" + fvalue + """" + vbCrLf
params = params + "Content-Type: " + fct + vbCrLf
params = params + vbCrLf
tempParamStream.WriteText params
'-------------------------------------
' バイナリデータ
'-------------------------------------
ChangeStreamType tempParamStream, adTypeBinary
Dim fileStream As Object
Set fileStream = CreateObject("ADODB.Stream")
fileStream.Type = adTypeBinary
fileStream.Open
fileStream.LoadFromFile fvalue
tempParamStream.Write fileStream.Read()
fileStream.Close
Set fileStream = Nothing
SetFileParmater = True
End Function
④フッタのパラメタ設定
Private Function SetEndParameter( _
ByRef tempParamStream As Object) As Boolean
ChangeStreamType tempParamStream, adTypeText
tempParamStream.WriteText getBoundy(adBTypeFooter)
SetEndParameter = True
End Function
⑤送信するパラメタを取得
Private Function GetSendParameter( _
ByRef parameter As Variant, _
ByRef stream As Object) As Boolean
ChangeStreamType stream, adTypeBinary
stream.Position = 0
parameter = stream.Read
stream.Close
Set stream = Nothing
GetSendParameter = True
End Function
Private Function ChangeStreamType( _
ByRef stream As Object, _
ByVal adType As Integer) As Boolean
Dim p As Long
p = stream.Position
stream.Position = 0
stream.Type = adType
If adType = adTypeText Then
stream.Charset = "UTF-8"
End If
stream.Position = p
ChangeStreamType = True
End Function
Private Function getBoundy(ByVal adType As Integer) As String
Static sBoundy As String
If sBoundy = "" Then
Dim multipartChars As String: multipartChars = "-_1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim boundary As String: boundary = "--------------------"
Dim i, point As Integer
For i = 1 To 20
Randomize
point = Int(Len(multipartChars) * Rnd + 1)
boundary = boundary + Mid(multipartChars, point, 1)
Next
sBoundy = boundary + Format(Now, "yyyymmddHHMMSS")
End If
Select Case adType
Case adBTypeContent
getBoundy = sBoundy
Case adBTypeBody
getBoundy = "--" + sBoundy + vbCrLf
Case adBTypeFooter
getBoundy = vbCrLf + "--" + sBoundy + "--" + vbCrLf
End Select
End Function
