Cetak Klaim Individual E-Klaim (lanjutan dari bridging ina cbg5 simrs dengan visual basic 6)
Selamat siang para bridgingers. Tutorial ini lanjutan dari tutorial sebelumnya, yang baru datang silahkan masuk kesini dulu
Bridging INACBG5 dengan visual basic 6 dan SLIM PHP
Kodenya seperti berikut:
Cetak klaim:
{
"metadata": {
"method": "claim_print"
},
"data": {
"nomor_sep": "16120507422"
}
}
Response:
{
"metadata": {
"code": 200,
"message": "Ok"
},
"data": “7c7uNsPO4uXsTpr9zCtiTrYdzMjmHxZIEjDobAoujnJvdO7UWTB
eRr9wb8mtnd9+gnzForViUj6QtD9xVBTJFxz4N/DvR7IwT7RqdQ
DsgFl5NnnWqZb/fNUKXQDQ+Q+e+yR48eo8bPF … dst”
}
Tool yang digunakan masih sama dengan yang kemarin. Bedanya di Visual Basic 6 ada tambahan modul untuk decode base64. Kemudian Jangan lupa ada aplikasi pembaca file pdf yang terinstall bukan yang portable. Saya pakai foxit reader.
Source code vb6 dan webservice php yang pernah aku upload di Bridging INACBG5 dengan visual basic 6 dan SLIM PHP.
Function cetak($request, $response, $args) {
$nosep = $request->getParsedBody()['nosep'];
//echo $nosep;
$json = '{
"metadata":{
"method":"claim_print"
},
"data":{
"nomor_sep":"'.$nosep.'"
}
}';
$json = mc_encrypt ($json, getKey());
$ch = curl_init(getUrlWS());
curl_setopt($ch, CURLOPT_POST, 1);
curl_setopt($ch, CURLOPT_POSTFIELDS, $json);
curl_setopt($ch, CURLOPT_RETURNTRANSFER, true);
$result = curl_exec($ch);
curl_close($ch);
$result = str_replace ('----BEGIN ENCRYPTED DATA----', '', $result);
$result = str_replace ('----END ENCRYPTED DATA----', '', $result);
$result = mc_decrypt (getKey(), $result);
$data = json_decode ($result, true);
$response->write($result);
$response->write($result);
return $response;
}
http://www.martinsetiawan.com/2017/03/bridging-ina-cbg5-simrs-dengan-visual_56.html
Kemudian akan terbuka form Add Module. Klik Open
Ganti nama modul menjadi Enc64,
Kemudian masukkan kode dibawah ini:
Option Explicit
Private Const clOneMask = 16515072 '000000 111111 111111 111111
Private Const clTwoMask = 258048 '111111 000000 111111 111111
Private Const clThreeMask = 4032 '111111 111111 000000 111111
Private Const clFourMask = 63 '111111 111111 111111 000000
Private Const clHighMask = 16711680 '11111111 00000000 00000000
Private Const clMidMask = 65280 '00000000 11111111 00000000
Private Const clLowMask = 255 '00000000 00000000 11111111
Private Const cl2Exp18 = 262144 '2 to the 18th power
Private Const cl2Exp12 = 4096 '2 to the 12th
Private Const cl2Exp6 = 64 '2 to the 6th
Private Const cl2Exp8 = 256 '2 to the 8th
Private Const cl2Exp16 = 65536 '2 to the 16th
Public Function Encode64(sString As String) As String
Dim bTrans(63) As Byte, lPowers8(255) As Long, lPowers16(255) As Long, bOut() As Byte, bIn() As Byte
Dim lChar As Long, lTrip As Long, iPad As Integer, lLen As Long, lTemp As Long, lPos As Long, lOutSize As Long
For lTemp = 0 To 63 'Fill the translation table.
Select Case lTemp
Case 0 To 25
bTrans(lTemp) = 65 + lTemp 'A - Z
Case 26 To 51
bTrans(lTemp) = 71 + lTemp 'a - z
Case 52 To 61
bTrans(lTemp) = lTemp - 4 '1 - 0
Case 62
bTrans(lTemp) = 43 'Chr(43) = "+"
Case 63
bTrans(lTemp) = 47 'Chr(47) = "/"
End Select
Next lTemp
For lTemp = 0 To 255 'Fill the 2^8 and 2^16 lookup tables.
lPowers8(lTemp) = lTemp * cl2Exp8
lPowers16(lTemp) = lTemp * cl2Exp16
Next lTemp
iPad = Len(sString) Mod 3 'See if the length is divisible by 3
If iPad Then 'If not, figure out the end pad and resize the input.
iPad = 3 - iPad
sString = sString & String(iPad, Chr(0))
End If
bIn = StrConv(sString, vbFromUnicode) 'Load the input string.
lLen = ((UBound(bIn) + 1) \ 3) * 4 'Length of resulting string.
lTemp = lLen \ 72 'Added space for vbCrLfs.
lOutSize = ((lTemp * 2) + lLen) - 1 'Calculate the size of the output buffer.
ReDim bOut(lOutSize) 'Make the output buffer.
lLen = 0 'Reusing this one, so reset it.
For lChar = LBound(bIn) To UBound(bIn) Step 3
lTrip = lPowers16(bIn(lChar)) + lPowers8(bIn(lChar + 1)) + bIn(lChar + 2) 'Combine the 3 bytes
lTemp = lTrip And clOneMask 'Mask for the first 6 bits
bOut(lPos) = bTrans(lTemp \ cl2Exp18) 'Shift it down to the low 6 bits and get the value
lTemp = lTrip And clTwoMask 'Mask for the second set.
bOut(lPos + 1) = bTrans(lTemp \ cl2Exp12) 'Shift it down and translate.
lTemp = lTrip And clThreeMask 'Mask for the third set.
bOut(lPos + 2) = bTrans(lTemp \ cl2Exp6) 'Shift it down and translate.
bOut(lPos + 3) = bTrans(lTrip And clFourMask) 'Mask for the low set.
If lLen = 68 Then 'Ready for a newline
bOut(lPos + 4) = 13 'Chr(13) = vbCr
bOut(lPos + 5) = 10 'Chr(10) = vbLf
lLen = 0 'Reset the counter
lPos = lPos + 6
Else
lLen = lLen + 4
lPos = lPos + 4
End If
Next lChar
If bOut(lOutSize) = 10 Then lOutSize = lOutSize - 2 'Shift the padding chars down if it ends with CrLf.
If iPad = 1 Then 'Add the padding chars if any.
bOut(lOutSize) = 61 'Chr(61) = "="
ElseIf iPad = 2 Then
bOut(lOutSize) = 61
bOut(lOutSize - 1) = 61
End If
Encode64 = StrConv(bOut, vbUnicode) 'Convert back to a string and return it.
End Function
Public Function Decode64(sString As String) As String
Dim bOut() As Byte, bIn() As Byte, bTrans(255) As Byte, lPowers6(63) As Long, lPowers12(63) As Long
Dim lPowers18(63) As Long, lQuad As Long, iPad As Integer, lChar As Long, lPos As Long, sOut As String
Dim lTemp As Long
sString = Replace(sString, vbCr, vbNullString) 'Get rid of the vbCrLfs. These could be in...
sString = Replace(sString, vbLf, vbNullString) 'either order.
lTemp = Len(sString) Mod 4 'Test for valid input.
If lTemp Then
Call Err.Raise(vbObjectError, "MyDecode", "Input string is not valid Base64.")
End If
If InStrRev(sString, "==") Then 'InStrRev is faster when you know it's at the end.
iPad = 2 'Note: These translate to 0, so you can leave them...
ElseIf InStrRev(sString, "=") Then 'in the string and just resize the output.
iPad = 1
End If
For lTemp = 0 To 255 'Fill the translation table.
Select Case lTemp
Case 65 To 90
bTrans(lTemp) = lTemp - 65 'A - Z
Case 97 To 122
bTrans(lTemp) = lTemp - 71 'a - z
Case 48 To 57
bTrans(lTemp) = lTemp + 4 '1 - 0
Case 43
bTrans(lTemp) = 62 'Chr(43) = "+"
Case 47
bTrans(lTemp) = 63 'Chr(47) = "/"
End Select
Next lTemp
For lTemp = 0 To 63 'Fill the 2^6, 2^12, and 2^18 lookup tables.
lPowers6(lTemp) = lTemp * cl2Exp6
lPowers12(lTemp) = lTemp * cl2Exp12
lPowers18(lTemp) = lTemp * cl2Exp18
Next lTemp
bIn = StrConv(sString, vbFromUnicode) 'Load the input byte array.
ReDim bOut((((UBound(bIn) + 1) \ 4) * 3) - 1) 'Prepare the output buffer.
For lChar = 0 To UBound(bIn) Step 4
lQuad = lPowers18(bTrans(bIn(lChar))) + lPowers12(bTrans(bIn(lChar + 1))) + _
lPowers6(bTrans(bIn(lChar + 2))) + bTrans(bIn(lChar + 3)) 'Rebuild the bits.
lTemp = lQuad And clHighMask 'Mask for the first byte
bOut(lPos) = lTemp \ cl2Exp16 'Shift it down
lTemp = lQuad And clMidMask 'Mask for the second byte
bOut(lPos + 1) = lTemp \ cl2Exp8 'Shift it down
bOut(lPos + 2) = lQuad And clLowMask 'Mask for the third byte
lPos = lPos + 3
Next lChar
sOut = StrConv(bOut, vbUnicode) 'Convert back to a string.
If iPad Then sOut = Left$(sOut, Len(sOut) - iPad) 'Chop off any extra bytes.
Decode64 = sOut
End Function
ganti nama class modul menjadi CetakKlaim,
Lalu Masukkan Kode dibawah ini
Private mNomorSEP As String
Private mServer As String
Public mData As String
Property Get NomorSEP() As String
NomorSEP = mNomorSEP
End Property
Property Let NomorSEP(Value As String)
mNomorSEP = Value
End Property
Property Get Server() As String
Server = mServer
End Property
Property Let Server(Value As String)
mServer = Value
End Property
Public Function cetak()
Dim Result As String
Dim tPost As String
Dim p As Object
Dim response As String
Dim xmlhttp As WinHttp.WinHttpRequest
Dim sUrl As String
tPost = "nosep=" & Me.NomorSEP
sUrl = "http://" & Me.Server & "/cetak"
Set xmlhttp = New WinHttp.WinHttpRequest
xmlhttp.Open "POST", sUrl, False
xmlhttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xmlhttp.Send tPost
If xmlhttp.Status = "200" Then
response = xmlhttp.ResponseText
Set xmlhttp = Nothing
Result = response
Set p = JSON.parse(Result)
ServerMessage = p.Item("metadata").Item("message")
ServerCode = p.Item("metadata").Item("code")
If ServerCode = "200" Then
mData = p.Item("data")
Dim s_enc As String
s_enc = Decode64(mData)
Dim judulfile As String
judulfile = App.Path & "\" & Me.NomorSEP & ".pdf"
Call FileWriteBinary(s_enc, judulfile)
ShellExecute MDIUtama.hWnd, vbNullString, judulfile, vbNullString, vbNullString, vbNormalFocus
Else
Call MsgBox("SERVER ERROR " & ServerCode, vbOKOnly)
End If
End If
End Function
Function FileWriteBinary(vData As Variant, sFileName As String, Optional bAppendToFile As Boolean = True) As Boolean
Dim iFileNum As Integer, lWritePos As Long
On Error GoTo ErrFailed
If bAppendToFile = False Then
If Len(Dir$(sFileName)) > 0 And Len(sFileName) > 0 Then
'Delete the existing file
VBA.Kill sFileName
End If
End If
iFileNum = FreeFile
Open sFileName For Binary Access Write As #iFileNum
If bAppendToFile = False Then
'Write to first byte
lWritePos = 1
Else
'Write to last byte + 1
lWritePos = LOF(iFileNum) + 1
End If
Put #iFileNum, lWritePos, vData
Close iFileNum
FileWriteBinary = True
Exit Function
ErrFailed:
FileWriteBinary = False
Close iFileNum
Debug.Print Err.Description
End Function
Dim ct As CetakKlaim
Set ct = New CetakKlaim
ct.NomorSEP = txtNoSEP.Text
'Ganti IpServer Lokal dengan server lokalmu
ct.Server = "ipserverlokal/BridgingInaCBG"
ct.cetak
Sumber:
Tentang base64 : https://lailatoel.wordpress.com/2012/09/20/cara-kerja-base64-encoding-decoding/
Bridging INACBG5 dengan visual basic 6 dan SLIM PHP
Suatu ketika ada seseorang verifikator E-Klaim komplain karena bridging terakhirnya tidak masuk. Ceritanya ada revisi diagnosa, lalu dia merasa sudah menginput, tetapi hasil iur bayar di kasir tidak sesuai dengan hasil inputannya. Setelah diinvestigasi, ternyata dia nggak menginput lewat aplikasi bridging yang aku buat. Karena data yang tersimpan di database adalah data bridging dia yang pertama. Tapi dia bersikukuh dengan bukti hasil print klaim individual. Lah dia pakai bukti print klaim individual, padahal di aplikasi bridging belum aku tambahi fasilitas buat ngeprint!!!
Akhirnya dia ngaku kalau ngeditnya pakai aplikasi E-Klaim. Nah Loh...
Kembali ke Laptop, eh ke artikel. Thanks to team NCC yang sudah membuatkan web service untuk kami para bridgingers. Fasilitas cetak klaim individual ini bisa dibaca di pdf petunjuk teknis Aplikasi INA-CBG5 bab webservice di bagian Cetak Klaim.
Kodenya seperti berikut:
Cetak klaim:
{
"metadata": {
"method": "claim_print"
},
"data": {
"nomor_sep": "16120507422"
}
}
Response:
{
"metadata": {
"code": 200,
"message": "Ok"
},
"data": “7c7uNsPO4uXsTpr9zCtiTrYdzMjmHxZIEjDobAoujnJvdO7UWTB
eRr9wb8mtnd9+gnzForViUj6QtD9xVBTJFxz4N/DvR7IwT7RqdQ
DsgFl5NnnWqZb/fNUKXQDQ+Q+e+yR48eo8bPF … dst”
}
Hasil dari method claim_print adalah file pdf yang ter-encode dengan base 64 yang terdapat pada variable “data”. Silakan decode terlebih dahulu untuk mendapatkan
file pdf dalam bentuk binary untuk kemudian ditampilkan atau disimpan.
Seperti sudah dijelaskan disana, filenya ada divariabel "data". Variabel ini adalah file yang di encode dengan base 64. Nah kendalanya disini, soalnya banyak yang nggak paham apa itu base 64, termasuk aku (sambil ngacung). Inilah kenapa artikel ini aku tulis. Mungkin teman-teman yang lain juga belum tahu tentang encode base 64, jadi biar kalian nggak ndeso kayak aku, yuk kita pelajari bersama
Base 64 Encoding Decoding
Sebelum kita melangkah lebih jauh, pikir-pikirkan dulu, sebelum dirimu... hadeh malah nyanyi dangdut. Yang tahu lagunya pasti seumuran sama yang nyanyi :P.
Base64 encoding/decoding adalah metoda yang digunakan untuk melakukan penyandian (encoding) terhadap file binary menjadi string. dengan kata lain. Binary dirubah menjadi menjadi 7 bit karakter.
Biar nggak terlalu panjang lebar, cukup sekian saja pembahasan soal base64. Intinya sih binary diencode menjadi string, nanti setelah sampai bisa dibalikin lagi ke sbinary.
Tehnik encoding sebenarnya sederhana
- Cari kode ASCII untuk masing-masing text
- Cari Bilangan binner 8 bit dari kode ASCII yang ada
- Gabungkan 8 bit menjadi 24 bit
- Pecah 24 bit menjadi 6 bit, sehingga akan menjadi 4 pecahan
- Masing-masing pecahan diubah menjadi nilai desimal
- jadikan nilai – nilai decimal tersebut menjadi indeks untuk memilih karakter penyusun dari base64 dan maksimal adalah 63 atau indeks ke 64
- Jika dalam proses encoding terdapat sisa pembagi, maka sebagai penggenap maka tambahkan karakter "=" sebagai karakter penggenap, sehingga kadang dalam string base64 ada dua karakter "="
PERSIAPAN
Tool yang digunakan masih sama dengan yang kemarin. Bedanya di Visual Basic 6 ada tambahan modul untuk decode base64. Kemudian Jangan lupa ada aplikasi pembaca file pdf yang terinstall bukan yang portable. Saya pakai foxit reader.Source code vb6 dan webservice php yang pernah aku upload di Bridging INACBG5 dengan visual basic 6 dan SLIM PHP.
Langkah pertama - Tambahkan Service Cetak di Web Service BridgingInaCBG
Tambahkan service cetak klaim di web service. Buka folder BridgingInaCBG.
Pada index.php, tambahkan service untuk cetak klaim
Berikut ini kodenya:
Function cetak($request, $response, $args) {
$nosep = $request->getParsedBody()['nosep'];
//echo $nosep;
$json = '{
"metadata":{
"method":"claim_print"
},
"data":{
"nomor_sep":"'.$nosep.'"
}
}';
$json = mc_encrypt ($json, getKey());
$ch = curl_init(getUrlWS());
curl_setopt($ch, CURLOPT_POST, 1);
curl_setopt($ch, CURLOPT_POSTFIELDS, $json);
curl_setopt($ch, CURLOPT_RETURNTRANSFER, true);
$result = curl_exec($ch);
curl_close($ch);
$result = str_replace ('----BEGIN ENCRYPTED DATA----', '', $result);
$result = str_replace ('----END ENCRYPTED DATA----', '', $result);
$result = mc_decrypt (getKey(), $result);
$data = json_decode ($result, true);
$response->write($result);
$response->write($result);
return $response;
}
Langkah Kedua - Buka Source Code Visual Basic 6
Buka file source code simulasi visual basic 6, kalau belum punya download saja diartikel inihttp://www.martinsetiawan.com/2017/03/bridging-ina-cbg5-simrs-dengan-visual_56.html
Langkah Ketiga - Tambahkan Modul Enc64
Modul ini aku dapat dari internet, Aku mohon maaf banget wahai creator modul, aku lupa alamat webnya, kalau nggak salah sih ngambil di forum diskusi. Kalau ada yang pernah nemu bisa menghubungiku, biar aku bisa menambahkan kredit creator modulnya di blog ini.
Masukkan Modul Enc64. Klik Kanan pada windows project explorer
Kemudian akan terbuka form Add Module. Klik Open
Ganti nama modul menjadi Enc64,
Kemudian masukkan kode dibawah ini:
Option Explicit
Private Const clOneMask = 16515072 '000000 111111 111111 111111
Private Const clTwoMask = 258048 '111111 000000 111111 111111
Private Const clThreeMask = 4032 '111111 111111 000000 111111
Private Const clFourMask = 63 '111111 111111 111111 000000
Private Const clHighMask = 16711680 '11111111 00000000 00000000
Private Const clMidMask = 65280 '00000000 11111111 00000000
Private Const clLowMask = 255 '00000000 00000000 11111111
Private Const cl2Exp18 = 262144 '2 to the 18th power
Private Const cl2Exp12 = 4096 '2 to the 12th
Private Const cl2Exp6 = 64 '2 to the 6th
Private Const cl2Exp8 = 256 '2 to the 8th
Private Const cl2Exp16 = 65536 '2 to the 16th
Public Function Encode64(sString As String) As String
Dim bTrans(63) As Byte, lPowers8(255) As Long, lPowers16(255) As Long, bOut() As Byte, bIn() As Byte
Dim lChar As Long, lTrip As Long, iPad As Integer, lLen As Long, lTemp As Long, lPos As Long, lOutSize As Long
For lTemp = 0 To 63 'Fill the translation table.
Select Case lTemp
Case 0 To 25
bTrans(lTemp) = 65 + lTemp 'A - Z
Case 26 To 51
bTrans(lTemp) = 71 + lTemp 'a - z
Case 52 To 61
bTrans(lTemp) = lTemp - 4 '1 - 0
Case 62
bTrans(lTemp) = 43 'Chr(43) = "+"
Case 63
bTrans(lTemp) = 47 'Chr(47) = "/"
End Select
Next lTemp
For lTemp = 0 To 255 'Fill the 2^8 and 2^16 lookup tables.
lPowers8(lTemp) = lTemp * cl2Exp8
lPowers16(lTemp) = lTemp * cl2Exp16
Next lTemp
iPad = Len(sString) Mod 3 'See if the length is divisible by 3
If iPad Then 'If not, figure out the end pad and resize the input.
iPad = 3 - iPad
sString = sString & String(iPad, Chr(0))
End If
bIn = StrConv(sString, vbFromUnicode) 'Load the input string.
lLen = ((UBound(bIn) + 1) \ 3) * 4 'Length of resulting string.
lTemp = lLen \ 72 'Added space for vbCrLfs.
lOutSize = ((lTemp * 2) + lLen) - 1 'Calculate the size of the output buffer.
ReDim bOut(lOutSize) 'Make the output buffer.
lLen = 0 'Reusing this one, so reset it.
For lChar = LBound(bIn) To UBound(bIn) Step 3
lTrip = lPowers16(bIn(lChar)) + lPowers8(bIn(lChar + 1)) + bIn(lChar + 2) 'Combine the 3 bytes
lTemp = lTrip And clOneMask 'Mask for the first 6 bits
bOut(lPos) = bTrans(lTemp \ cl2Exp18) 'Shift it down to the low 6 bits and get the value
lTemp = lTrip And clTwoMask 'Mask for the second set.
bOut(lPos + 1) = bTrans(lTemp \ cl2Exp12) 'Shift it down and translate.
lTemp = lTrip And clThreeMask 'Mask for the third set.
bOut(lPos + 2) = bTrans(lTemp \ cl2Exp6) 'Shift it down and translate.
bOut(lPos + 3) = bTrans(lTrip And clFourMask) 'Mask for the low set.
If lLen = 68 Then 'Ready for a newline
bOut(lPos + 4) = 13 'Chr(13) = vbCr
bOut(lPos + 5) = 10 'Chr(10) = vbLf
lLen = 0 'Reset the counter
lPos = lPos + 6
Else
lLen = lLen + 4
lPos = lPos + 4
End If
Next lChar
If bOut(lOutSize) = 10 Then lOutSize = lOutSize - 2 'Shift the padding chars down if it ends with CrLf.
If iPad = 1 Then 'Add the padding chars if any.
bOut(lOutSize) = 61 'Chr(61) = "="
ElseIf iPad = 2 Then
bOut(lOutSize) = 61
bOut(lOutSize - 1) = 61
End If
Encode64 = StrConv(bOut, vbUnicode) 'Convert back to a string and return it.
End Function
Public Function Decode64(sString As String) As String
Dim bOut() As Byte, bIn() As Byte, bTrans(255) As Byte, lPowers6(63) As Long, lPowers12(63) As Long
Dim lPowers18(63) As Long, lQuad As Long, iPad As Integer, lChar As Long, lPos As Long, sOut As String
Dim lTemp As Long
sString = Replace(sString, vbCr, vbNullString) 'Get rid of the vbCrLfs. These could be in...
sString = Replace(sString, vbLf, vbNullString) 'either order.
lTemp = Len(sString) Mod 4 'Test for valid input.
If lTemp Then
Call Err.Raise(vbObjectError, "MyDecode", "Input string is not valid Base64.")
End If
If InStrRev(sString, "==") Then 'InStrRev is faster when you know it's at the end.
iPad = 2 'Note: These translate to 0, so you can leave them...
ElseIf InStrRev(sString, "=") Then 'in the string and just resize the output.
iPad = 1
End If
For lTemp = 0 To 255 'Fill the translation table.
Select Case lTemp
Case 65 To 90
bTrans(lTemp) = lTemp - 65 'A - Z
Case 97 To 122
bTrans(lTemp) = lTemp - 71 'a - z
Case 48 To 57
bTrans(lTemp) = lTemp + 4 '1 - 0
Case 43
bTrans(lTemp) = 62 'Chr(43) = "+"
Case 47
bTrans(lTemp) = 63 'Chr(47) = "/"
End Select
Next lTemp
For lTemp = 0 To 63 'Fill the 2^6, 2^12, and 2^18 lookup tables.
lPowers6(lTemp) = lTemp * cl2Exp6
lPowers12(lTemp) = lTemp * cl2Exp12
lPowers18(lTemp) = lTemp * cl2Exp18
Next lTemp
bIn = StrConv(sString, vbFromUnicode) 'Load the input byte array.
ReDim bOut((((UBound(bIn) + 1) \ 4) * 3) - 1) 'Prepare the output buffer.
For lChar = 0 To UBound(bIn) Step 4
lQuad = lPowers18(bTrans(bIn(lChar))) + lPowers12(bTrans(bIn(lChar + 1))) + _
lPowers6(bTrans(bIn(lChar + 2))) + bTrans(bIn(lChar + 3)) 'Rebuild the bits.
lTemp = lQuad And clHighMask 'Mask for the first byte
bOut(lPos) = lTemp \ cl2Exp16 'Shift it down
lTemp = lQuad And clMidMask 'Mask for the second byte
bOut(lPos + 1) = lTemp \ cl2Exp8 'Shift it down
bOut(lPos + 2) = lQuad And clLowMask 'Mask for the third byte
lPos = lPos + 3
Next lChar
sOut = StrConv(bOut, vbUnicode) 'Convert back to a string.
If iPad Then sOut = Left$(sOut, Len(sOut) - iPad) 'Chop off any extra bytes.
Decode64 = sOut
End Function
Langkah ke Empat - Buat Class Modul Cetak Klaim
Buat Class Modul baru, caranya klik kanan di jendela explore project, kemuduan pilih Add=>Class Modulules
ganti nama class modul menjadi CetakKlaim,
Lalu Masukkan Kode dibawah ini
Private mNomorSEP As String
Private mServer As String
Public mData As String
Property Get NomorSEP() As String
NomorSEP = mNomorSEP
End Property
Property Let NomorSEP(Value As String)
mNomorSEP = Value
End Property
Property Get Server() As String
Server = mServer
End Property
Property Let Server(Value As String)
mServer = Value
End Property
Public Function cetak()
Dim Result As String
Dim tPost As String
Dim p As Object
Dim response As String
Dim xmlhttp As WinHttp.WinHttpRequest
Dim sUrl As String
tPost = "nosep=" & Me.NomorSEP
sUrl = "http://" & Me.Server & "/cetak"
Set xmlhttp = New WinHttp.WinHttpRequest
xmlhttp.Open "POST", sUrl, False
xmlhttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xmlhttp.Send tPost
If xmlhttp.Status = "200" Then
response = xmlhttp.ResponseText
Set xmlhttp = Nothing
Result = response
Set p = JSON.parse(Result)
ServerMessage = p.Item("metadata").Item("message")
ServerCode = p.Item("metadata").Item("code")
If ServerCode = "200" Then
mData = p.Item("data")
Dim s_enc As String
s_enc = Decode64(mData)
Dim judulfile As String
judulfile = App.Path & "\" & Me.NomorSEP & ".pdf"
Call FileWriteBinary(s_enc, judulfile)
ShellExecute MDIUtama.hWnd, vbNullString, judulfile, vbNullString, vbNullString, vbNormalFocus
Else
Call MsgBox("SERVER ERROR " & ServerCode, vbOKOnly)
End If
End If
End Function
Function FileWriteBinary(vData As Variant, sFileName As String, Optional bAppendToFile As Boolean = True) As Boolean
Dim iFileNum As Integer, lWritePos As Long
On Error GoTo ErrFailed
If bAppendToFile = False Then
If Len(Dir$(sFileName)) > 0 And Len(sFileName) > 0 Then
'Delete the existing file
VBA.Kill sFileName
End If
End If
iFileNum = FreeFile
Open sFileName For Binary Access Write As #iFileNum
If bAppendToFile = False Then
'Write to first byte
lWritePos = 1
Else
'Write to last byte + 1
lWritePos = LOF(iFileNum) + 1
End If
Put #iFileNum, lWritePos, vData
Close iFileNum
FileWriteBinary = True
Exit Function
ErrFailed:
FileWriteBinary = False
Close iFileNum
Debug.Print Err.Description
End Function
Langkah Kelima - Buat Form Cetak
Buat Form baru untuk tombol cetak. Buat text box untuk memasukkan NoSEP, beri nama txtNoSEP. dan 1 tombol untuk mencetak, cmdCetak
Ini contoh tampilannya, sangat sederhana, jauh sekali dari kesan indah atau mawar
Dim ct As CetakKlaim
Set ct = New CetakKlaim
ct.NomorSEP = txtNoSEP.Text
'Ganti IpServer Lokal dengan server lokalmu
ct.Server = "ipserverlokal/BridgingInaCBG"
ct.cetak
Langkah KeEnam - Semoga Berhasil
Okay aplikasinya sudah siap. Terima kasih sudah mampir disini, silahkan Mencoba dan jangan lupa kalau ada yang ingin ditanyakan tanyakanlah. Insyaallah aku bantu semampuku.Sumber:
Tentang base64 : https://lailatoel.wordpress.com/2012/09/20/cara-kerja-base64-encoding-decoding/
Semangaaaaaaaaaaat coding, tapi jangan lupakan aku dan anak2 yaaa, hihi :)
ReplyDeleteiyaaaa cinn
DeleteWih mantep gan ..
ReplyDeleteterima kasih gan
DeletePak martin mantap
ReplyDeleteterima kasih pak, semoga bermanfaat
DeleteSangat bermanfaat dan membantu kami pak Martin...semoga pak Martin semakin sukses
ReplyDelete