Tenda & alkhal

اهلا بك تشرفننا بحضورك
الخال
Tenda & alkhal

كل مايحتاجه الهكر العراقي هنا..


    كودات فجول بيسك

    شاطر
    avatar
    الخال مصطفى
    كبار الشخصيات
    كبار الشخصيات

    عدد المساهمات : 66
    تاريخ التسجيل : 23/03/2012
    الموقع : بغداد

    كودات فجول بيسك

    مُساهمة  الخال مصطفى في الأحد مارس 25, 2012 4:27 pm

    كود لتخطي مواقع الفحص المشهوره
    كود:
    ' This CodeD By : DeaD SouL

    Option Explicit

    Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088

    Private Const FILE_SHARE_READ = &H1
    Private Const FILE_SHARE_WRITE = &H2
    Private Const GENERIC_READ = &H80000000
    Private Const GENERIC_WRITE = &H40000000
    Private Const OPEN_EXISTING = 3
    'Private Const CREATE_NEW = 1
    Private Const CREATE_ALWAYS = 2

    Private Type IDEREGS
    bFeaturesReg As Byte
    bSectorCountReg As Byte
    bSectorNumberReg As Byte
    bCylLowReg As Byte
    bCylHighReg As Byte
    bDriveHeadReg As Byte
    bCommandReg As Byte
    bReserved As Byte
    End Type

    Private Type SENDCMDINPARAMS
    cBufferSize As Long
    irDriveRegs As IDEREGS
    bDriveNumber As Byte
    bReserved(1 To 3) As Byte
    dwReserved(1 To 4) As Long
    End Type

    Private Type DRIVERSTATUS
    bDriveError As Byte
    bIDEStatus As Byte
    bReserved(1 To 2) As Byte
    dwReserved(1 To 2) As Long
    End Type

    Private Type SENDCMDOUTPARAMS
    cBufferSize As Long
    DStatus As DRIVERSTATUS
    bBuffer(1 To 512) As Byte
    End Type


    Private Declare Function CreateFileA Lib "kernel32" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, ByVal lpOverlapped As Long) As Long
    Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As Long)
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

    Private mvarCurrentDrive As Byte
    Private mvarPlatform As String

    Public Function GetPhysicalDriveModelName() As String

    Dim bin As SENDCMDINPARAMS
    Dim bout As SENDCMDOUTPARAMS
    Dim hdh As Long
    Dim br As Long
    Dim ix As Long
    Dim sTemp As String

    hdh = CreateFileA("\\.\PhysicalDrive0", GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ + FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)

    ZeroMemory bin, Len(bin)
    ZeroMemory bout, Len(bout)

    With bin
    .bDriveNumber = mvarCurrentDrive
    .cBufferSize = 512
    With .irDriveRegs
    If (mvarCurrentDrive And 1) Then
    .bDriveHeadReg = &HB0
    Else
    .bDriveHeadReg = &HA0
    End If
    .bCommandReg = &HEC
    .bSectorCountReg = 1
    .bSectorNumberReg = 1
    End With
    End With

    DeviceIoControl hdh, DFP_RECEIVE_DRIVE_DATA, bin, Len(bin), bout, Len(bout), br, 0

    For ix = 55 To 94 Step 2
    If bout.bBuffer(ix + 1) = 0 Then Exit For
    sTemp = sTemp & Chr(bout.bBuffer(ix + 1))
    If bout.bBuffer(ix) = 0 Then Exit For
    sTemp = sTemp & Chr(bout.bBuffer(ix))
    Next ix

    CloseHandle hdh
    GetPhysicalDriveModelName = Trim(sTemp)
    End Function

    Public Sub PrintSandboxed(szMsg As String)
    Dim hFile As Long
    hFile = CreateFileA(szMsg, GENERIC_WRITE, 0, 0&, CREATE_ALWAYS, 0, 0&)
    CloseHandle hFile
    End Sub

    او هذا كود ثاني هم تخطي بعد مواقع القحص

    هذا اتخليه في الموديل

    كود:
    Option Explicit

    Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
    Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
    Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
    Private Declare Sub CloseHandle Lib "kernel32" (ByVal hObject As Long)
    Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long

    Private Const TH32CS_SNAPPROCESS = &H2
    Private Const MAX_PATH As Long = 260

    Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * MAX_PATH
    End Type

    Function vm()
    Dim oAdapters As Object
    Dim oCard As Object
    Dim SQL As String



    ' Abfrage erstellen
    SQL = "SELECT * FROM Win32_VideoController"
    Set oAdapters = GetObject("winmgmts:").ExecQuery(SQL)

    ' Auflisten aller Grafikadapter
    For Each oCard In oAdapters
    Select Case oCard.Description

    Case "VM Additions S3 Trio32/64"
    MsgBox "MS VPC with Additions found!", vbInformation

    Case "S3 Trio32/64"
    MsgBox "MS VPC without Additions found!", vbInformation

    Case "VirtualBox Graphics Adapter"
    MsgBox "VirtualBox with Additions found!", vbInformation


    Case "VMware SVGA II"
    MsgBox "VMWare with Additions found!", vbInformation

    Case ""
    MsgBox "VM found!", vbInformation

    Case Else
    MsgBox "I'm not running in a VM!", vbInformation
    End Select



    Next
    End Function



    Public Function Sandboxed() As Boolean
    Dim nSnapshot As Long, nProcess As PROCESSENTRY32
    Dim nResult As Long, ParentID As Long, IDCheck As Boolean
    Dim nProcessID As Long

    'Eigene ProcessID ermitteln
    nProcessID = GetCurrentProcessId
    If nProcessID <> 0 Then
    'Abbild der Prozesse machen
    nSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
    If nSnapshot <> 0 Then
    nProcess.dwSize = Len(nProcess)

    'Zeiger auf ersten Prozess bewegen
    nResult = ProcessFirst(nSnapshot, nProcess)

    Do Until nResult = 0
    'Nach der eigenen ProcessID suchen.
    If nProcess.th32ProcessID = nProcessID Then

    'Wir merken uns die ParentProcessID
    ParentID = nProcess.th32ParentProcessID

    'Wir beginnen nochmal beim ersten Prozess
    nResult = ProcessFirst(nSnapshot, nProcess)
    Do Until nResult = 0
    'Wir suchen den Process mit der ParentID
    If nProcess.th32ProcessID = ParentID Then
    'Falls so ein Prozess vorhanden ist, dann ist das Programm nicht sandboxed
    IDCheck = False
    Exit Do
    Else
    IDCheck = True
    nResult = ProcessNext(nSnapshot, nProcess)
    End If
    Loop

    'Falls check True ist, dann ist das Programm Sandboxed
    Sandboxed = IDCheck

    Exit Do
    Else
    'Zum nchsten Prozess
    nResult = ProcessNext(nSnapshot, nProcess)
    End If
    Loop
    Handle wird geschloكen
    CloseHandle nSnapshot
    End If
    End If
    End Function

    هذا كود لتعطيل الموس ولكيبورد عن تجربتي او مضمون

    بلفروم لورد
    كود:
    Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Sub Form_Activate()
    DoEvents
    ' إيقاف لوحة المفاتيح والماوس عن العمل
    BlockInput True
    ' الانتظار عشر ثواني
    Sleep 10000
    ' إعادة لوحة المفاتيح والماوس للعمل مرة أخرى
    BlockInput False
    End Sub
    كود تلوين الفروم بالوان قوز قزح هـع
    كود:
    Private Sub Form_Load()
    Me.AutoRedraw = True
    Me.ScaleMode = vbTwips
    Me.Caption = "Rainbow Generator by " & _
    "ghost baghdad"
    End Sub
    Private Sub Form_Resize()
    Call Rainbow
    End Sub
    Private Sub Rainbow()
    On Error Resume Next
    Dim Position As Integer, Red As Integer, Green As _
    Integer, Blue As Integer
    Dim ScaleFactor As Double, Length As Integer
    ScaleFactor = Me.ScaleWidth / (255 * 6)
    Length = Int(ScaleFactor * 255)
    Position = 0
    Red = 255
    Blue = 1
    For Green = 1 To Length
    Me.Line (Position, 0)-(Position, Me.ScaleHeight), _
    RGB(Red, Green \ ScaleFactor, Blue)
    Position = Position + 1
    Next Green
    For Red = Length To 1 Step -1
    Me.Line (Position, 0)-(Position, Me.ScaleHeight), _
    RGB(Red \ ScaleFactor, Green, Blue)
    Position = Position + 1
    Next Red
    For Blue = 0 To Length
    Me.Line (Position, 0)-(Position, Me.ScaleHeight), _
    RGB(Red, Green, Blue \ ScaleFactor)
    Position = Position + 1
    Next Blue
    For Green = Length To 1 Step -1
    Me.Line (Position, 0)-(Position, Me.ScaleHeight), _
    RGB(Red, Green \ ScaleFactor, Blue)
    Position = Position + 1
    Next Green
    For Red = 1 To Length
    Me.Line (Position, 0)-(Position, Me.ScaleHeight), _
    RGB(Red \ ScaleFactor, Green, Blue)
    Position = Position + 1
    Next Red
    For Blue = Length To 1 Step -1
    Me.Line (Position, 0)-(Position, Me.ScaleHeight), _
    RGB(Red, Green, Blue \ ScaleFactor)
    Position = Position + 1
    Next Blue
    End Sub
    كود يخلي الفروم 3D
    كود:
    Public Sub ThreeDForm(frmForm As Form)
    Const cPi = 3.1415926
    Dim intLineWidth As Integer
    intLineWidth = 5
    Dim intSaveScaleMode As Integer
    intSaveScaleMode = frmForm.ScaleMode
    frmForm.ScaleMode = 3
    Dim intScaleWidth As Integer
    Dim intScaleHeight As Integer
    intScaleWidth = frmForm.ScaleWidth
    intScaleHeight = frmForm.ScaleHeight
    frmForm.Cls
    frmForm.Line (0, intScaleHeight)-(intLineWidth, 0), &HFFFFFF, BF
    frmForm.Line (0, intLineWidth)-(intScaleWidth, 0), &HFFFFFF, BF
    frmForm.Line (intScaleWidth, 0)-(intScaleWidth - intLineWidth, _
    intScaleHeight), &H808080, BF
    frmForm.Line (intScaleWidth, intScaleHeight - intLineWidth)-(0, _
    intScaleHeight), &H808080, BF
    Dim intCircleWidth As Integer
    intCircleWidth = Sqr(intLineWidth * intLineWidth + intLineWidth _
    * intLineWidth)
    frmForm.FillStyle = 0
    frmForm.FillColor = QBColor(15)
    frmForm.Circle (intLineWidth, intScaleHeight - intLineWidth), _
    intCircleWidth, _
    QBColor(15), -3.1415926, -3.90953745777778
    frmForm.Circle (intScaleWidth - intLineWidth, intLineWidth), _
    intCircleWidth, _
    QBColor(15), -0.78539815, -1.5707963
    frmForm.Line (0, intScaleHeight)-(0, 0), 0
    frmForm.Line (0, 0)-(intScaleWidth - 1, 0), 0
    frmForm.Line (intScaleWidth - 1, 0)-(intScaleWidth - 1, _
    intScaleHeight - 1), 0
    frmForm.Line (0, intScaleHeight - 1)-(intScaleWidth - 1, _
    intScaleHeight - 1), 0
    frmForm.ScaleMode = intSaveScaleMode
    End Sub

    Private Sub Form_Resize()
    ThreeDForm Me
    End Sub
    كود رش الالوان على الفروم عن تئشير الموس
    كود:
    Private Sub Form_Load()
    Me.AutoRedraw = True
    End Sub

    Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    X = Me.CurrentX
    Y = Me.CurrentY
    End Sub
    Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Me.PSet (X + Rnd * 255, Y + Rnd * 255), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
    Me.PSet (X + Rnd * 255, Y + Rnd * 255), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
    Me.PSet (X + Rnd * 255, Y + Rnd * 255), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
    Me.PSet (X + Rnd * 255, Y + Rnd * 255), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
    End Sub
    احلى كود او عجبني حيل كمان هههههههههههههه

    جربوه او شوفو

    هذا الكود خلوه في الفروم

    كود:
    private sub form_load()
    timer1.interval = 250
    end sub
    او هذا الكود خلوه في التايمر

    كود:
    private sub timer1_timer()
    randomize
    me.backcolor = rgb(rnd * 255, rnd * 255, rnd * 255)
    me.move rnd * 12000, rnd * 9000, rnd * 12000, rnd * 9000
    end sub
    هذا الكود يخلي الفروم ماينلزم لو تفحط ههههههههههه
    بس تكدر اتوكفه من الفيوجل بيسك من التيست
    ______________________________

    كود لفتح الفروم من الاصغر لاكبر كود روعه
    كود:
    Sub Explode(form1 As Form)
    form1.Width = 0
    form1.Height = 0
    form1.Show
    For x = 0 To 5000 Step 1
    form1.Width = x
    form1.Height = x
    With form1
    .Left = (Screen.Width - .Width) / 2
    .Top = (Screen.Height - .Height) / 2
    End With
    Next

    End Sub
    Private Sub Form_Load()
    Explode Me
    End Sub
    كود يخلي الفروم فيه دوائر
    كود:
    function dist(x1, y1, x2, y2) as single
    dim a as single, b as single
    a = (x2 - y1) * (x2 - x1)
    b = (y2 - y1) * (y2 - y1)
    dist = sqr(a + b)
    end function
    sub moveit(a, b, t)
    a = (1 - t) * a + t * b
    end sub

    private sub form_click()
    cls
    dim t as single, x1 as single, y1 as single
    dim x2 as single, y2 as single, x3 as single
    dim y3 as single, x4 as single, y4 as single

    scale (-320, 200)-(320, -200)
    t = 0.05
    x1 = -320: Y1 = 200
    x2 = 320: Y2 = 200
    x3 = 320: Y3 = -200
    x4 = -320: Y4 = -200
    do until dist(x1, y1, x2, y2) < 10
    line (x1, y1)-(x2, y2)
    line -(x3, y3)
    line -(x4, y4)
    line -(x1, y1)
    moveit x1, x2, t
    moveit y1, y2, t
    moveit x2, x3, t
    moveit y2, y3, t
    moveit x3, x4, t
    moveit y3, y4, t
    moveit x4, x1, t
    moveit y4, y1, t
    loop
    end sub

    private sub form_resize()
    cls
    dim t as single, x1 as single, y1 as single
    dim x2 as single, y2 as single, x3 as single
    dim y3 as single, x4 as single, y4 as single

    scale (-320, 200)-(320, -200)
    t = 0.05
    x1 = -320: Y1 = 200
    x2 = 320: Y2 = 200
    x3 = 320: Y3 = -200
    x4 = -320: Y4 = -200
    do until dist(x1, y1, x2, y2) < 10
    line (x1, y1)-(x2, y2)
    line -(x3, y3)
    line -(x4, y4)
    line -(x1, y1)
    moveit x1, x2, t
    moveit y1, y2, t
    moveit x2, x3, t
    moveit y2, y3, t
    moveit x3, x4, t
    moveit y3, y4, t
    moveit x4, x1, t
    moveit y4, y1, t
    loop
    end sub
    كود لانهاء البرنامج في 3 مرات مجرب مني

    او ما تكدر اشغله وره الـ3 مرات
    كود:
    Private Sub Form_Load()
    retvalue = GetSetting("A", "0", "Runcount")
    GD$ = Val(retvalue) + 1
    SaveSetting "A", "0", "RunCount", GD$
    If GD$ > 3 Then ' الرقم (3) يحدد عدد مرات التشغيل
    MsgBox "انتهت مدة تشغيل البرنامج .. عليك بشراء النسخة الاصلية"
    Unload FRM '
    End If
    End Sub


    _________________
    الخال مصطفى

      الوقت/التاريخ الآن هو الإثنين مارس 27, 2017 10:30 pm