AlanElston icon

PubicProperlyLetGet

AlanElston | PRO | 12/09/18 02:35:37 PM UTC | 0 ⭐ | 5809 👁️ | Never ⏰ | []
VisualBasic |

11.61 KB

|

None

|

0 👍

/

0 👎

 
 
 
 
 
 
 
 
 
 
 
 
' Leave some lines free above
'  http://www.eileenslounge.com/viewtopic.php?f=30&t=31395#p242918
 
Sub WotchaGotInHorizontalClit() 'Examine what is copied to clipboard from a row, and paste it into code module
Rem 0 Test range
Range("A1:C1").Value = Array("A1", "B1", "C1")
Rem 1 Clitbored
Range("A1:C1").Copy
Dim objDataObject As Object '  DataObject Late Binding equivalent            ' http://excelmatters.com/2013/09/23/vba-references-and-early-binding-vs-late-binding/     http://www.excelfox.com/forum/showthread.php/2240-VBA-referring-to-external-shared-Libraries-1)-Early-1-5)-Laterly-Early-and-2)-Late-Binding-Techniques
 Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
 objDataObject.GetFromClipboard
Dim strIn As String: Let strIn = objDataObject.GetText() 'String of range as held in clitbored
Rem 2 examine string from clitbored
Dim myLenf As Long: Let myLenf = Len(strIn)
Dim cnt As Long
    For cnt = 1 To myLenf
    Dim Caracter As Variant ' String
     Let Caracter = Mid(strIn, cnt, 1)
    Dim WotchaGot As String
        If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then ' Check for normal characters
         Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
        Else
         Select Case Caracter
          Case " "
           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
          Case vbCr
           Let WotchaGot = WotchaGot & "vbCr & "
          Case vbLf
           Let WotchaGot = WotchaGot & "vbLf & "
          Case vbCrLf
           Let WotchaGot = WotchaGot & "vbCrLf & "
          Case """"
           Let WotchaGot = WotchaGot & """" & """" & """" & " & "
          Case vbTab
           Let WotchaGot = WotchaGot & "vbTab & "
          Case Else
           WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
           'Let CaseElse = Caracter
         End Select
        End If
    Next cnt
    If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3) ' take off last " & "
 MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot
Rem 4 paste into code module
 On Error Resume Next
 ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.AddFromString "Rem    " & strIn ' a Rem is added to stop the code module showing red error
 Set objDataObject = Nothing
End Sub
 
'
Sub WotchaGotInCodeWindowHorizontal() ' Examine first line of text in the code module
Rem 1 Put first line from code module into a string
Dim strVonCodMod As String
 Let strVonCodMod = ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.Lines(Startline:=1, Count:=1)
 Let strVonCodMod = Replace(strVonCodMod, "Rem    ", "", 1, -1, vbBinaryCompare)
Rem 2 examine string from code module line 1
Dim myLenf As Long: Let myLenf = Len(strVonCodMod)
Dim cnt As Long
    For cnt = 1 To myLenf
    Dim Caracter As Variant ' String
     Let Caracter = Mid(strVonCodMod, cnt, 1)
    Dim WotchaGot As String
        If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then
         Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
        Else
         Select Case Caracter
          Case " "
           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
          Case vbCr
           Let WotchaGot = WotchaGot & "vbCr & "
          Case vbLf
           Let WotchaGot = WotchaGot & "vbLf & "
          Case vbCrLf
           Let WotchaGot = WotchaGot & "vbCrLf & "
          Case """"
           Let WotchaGot = WotchaGot & """" & """" & """" & " & "
          Case vbTab
           Let WotchaGot = WotchaGot & "vbTab & "
          Case Else
           WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
           'Let CaseElse = Caracter
         End Select
        End If
    Next cnt
    If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3)
 MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot
Rem 3 clipbored
'3a Put string from first code module line in clipbored
Dim objDataObject As Object '
 Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
 objDataObject.SetText strVonCodMod
 objDataObject.PutInClipboard
 Set objDataObject = Nothing
'3b paste string from first code module line into worksheet
 Range("A1:C1").ClearContents
 Paste Destination:=Range("A1")
Rem 4 Delete first line from code module
 On Error Resume Next
 ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.DeleteLines Startline:=1, Count:=1
End Sub
 
 
'
Sub WotchaGotInVirticalClit() ''Examine what is copied to clipboard from a column, and paste it into code module
Rem 0 Test range
Dim WhoRay(1 To 3, 1 To 1) As String: Let WhoRay(1, 1) = "A1": Let WhoRay(2, 1) = "A2": Let WhoRay(3, 1) = "A3"
 Let Range("A1:A3").Value = WhoRay
Rem 1 Clipboard
 Range("A1:A3").Copy
Dim objDataObject As Object
 Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
 objDataObject.GetFromClipboard
Dim strIn As String: Let strIn = objDataObject.GetText()
Rem 2 Examine string held in clipboard from a copy from a column
Dim myLenf As Long: Let myLenf = Len(strIn)
Dim cnt As Long
    For cnt = 1 To myLenf
    Dim Caracter As Variant ' String
     Let Caracter = Mid(strIn, cnt, 1)
    Dim WotchaGot As String
        If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then
         Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
        Else
         Select Case Caracter
          Case " "
           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
          Case vbCr
           Let WotchaGot = WotchaGot & "vbCr & "
          Case vbLf
           Let WotchaGot = WotchaGot & "vbLf & "
          Case vbCrLf
           Let WotchaGot = WotchaGot & "vbCrLf & "
          Case """"
           Let WotchaGot = WotchaGot & """" & """" & """" & " & "
          Case vbTab
           Let WotchaGot = WotchaGot & "vbTab & "
          Case Else
           WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
         End Select
        End If
    Next cnt
    If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3)
 MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot
Rem 4 Paste stringt from clipboard into top of code module
 On Error Resume Next
 ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.AddFromString "Rem    " & Replace(strIn, vbLf, vbLf & "Rem    ", 1, 2, vbBinaryCompare)
 Set objDataObject = Nothing
End Sub
 
Sub WotchaGotInCodeWindowVertical() ' Examins what is held in a code module after pasting in a column froma worksheet
Rem 1 Put first 4 lines from code module into a string
Dim strVonCodMod As String
 Let strVonCodMod = ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.Lines(Startline:=1, Count:=4)
 Let strVonCodMod = Replace(strVonCodMod, "Rem    ", "", 1, -1, vbBinaryCompare)
Rem 2 Examine contents of string
Dim myLenf As Long: Let myLenf = Len(strVonCodMod)
Dim cnt As Long
    For cnt = 1 To myLenf
    Dim Caracter As Variant ' String
     Let Caracter = Mid(strVonCodMod, cnt, 1)
    Dim WotchaGot As String
        If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then
         Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
        Else
         Select Case Caracter
          Case " "
           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
          Case vbCr
           Let WotchaGot = WotchaGot & "vbCr & "
          Case vbLf
           Let WotchaGot = WotchaGot & "vbLf & "
          Case vbCrLf
           Let WotchaGot = WotchaGot & "vbCrLf & "
          Case """"
           Let WotchaGot = WotchaGot & """" & """" & """" & " & "
          Case vbTab
           Let WotchaGot = WotchaGot & "vbTab & "
          Case Else
           WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
           'Let CaseElse = Caracter
         End Select
        End If
    Next cnt
    If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3)
 MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot
Rem 3 Clipboard
'3a Put string into clipboard
Dim objDataObject As Object '
 Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
 objDataObject.SetText strVonCodMod
 objDataObject.PutInClipboard
 Set objDataObject = Nothing
'3b Paste into worksheet from clipboard
 Paste Destination:=Range("A1")
Rem 4 Delet first 4 rows from code module
 On Error Resume Next
 ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.DeleteLines Startline:=1, Count:=4
End Sub
 
 
 
Sub Pubic_Properly_Let_RngAsString_() ' Examination of a range  copied to clipboard, then paste to Private Class code module
 Range("A1:C1").Value = Array("A1", "B1", "C1")
 Range("A2:C2").Value = Array("A2", "B2", "C2")
 Range("A3:C3").Value = Array("A3", "B3", "C3")
 Range("A1:C3").Copy
Dim objDataObject As Object
 Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
 objDataObject.GetFromClipboard
Dim strIn As String: Let strIn = objDataObject.GetText()
Dim myLenf As Long: Let myLenf = Len(strIn)
Dim cnt As Long
    For cnt = 1 To myLenf
    Dim Caracter As Variant ' String
     Let Caracter = Mid(strIn, cnt, 1)
    Dim WotchaGot As String
        If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then
         Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
        Else
         Select Case Caracter
          Case " "
           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
          Case vbCr
           Let WotchaGot = WotchaGot & "vbCr & "
          Case vbLf
           Let WotchaGot = WotchaGot & "vbLf & "
          Case vbCrLf
           Let WotchaGot = WotchaGot & "vbCrLf & "
          Case """"
           Let WotchaGot = WotchaGot & """" & """" & """" & " & "
          Case vbTab
           Let WotchaGot = WotchaGot & "vbTab & "
          Case Else
           WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
           Let CaseElse = Caracter
         End Select
        End If
    Next cnt
    If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3)
 MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot: Debug.Print
 MsgBox Prompt:=Replace(WotchaGot, "vbLf & ", "vbLf" & vbCrLf, 1, -1, vbBinaryCompare): Debug.Print Replace(WotchaGot, "vbLf & ", "vbLf" & vbCrLf, 1, -1, vbBinaryCompare): Debug.Print
 MsgBox Prompt:=Replace(WotchaGot, "vbTab", """ | """, 1, -1, vbBinaryCompare): Debug.Print Replace(WotchaGot, "vbTab", """ | """, 1, -1, vbBinaryCompare): Debug.Print
 
 Let strIn = Replace(strIn, vbTab, " | ", 1, -1, vbBinaryCompare) ' replace tab with  |
 MsgBox Prompt:=strIn: Debug.Print strIn
 
 Let strIn = "Rem    " & Replace(strIn, vbLf, vbLf & "Rem    ", 1, 2, vbBinaryCompare) ' add some Rems to prevent red error in code window
 Debug.Print
 On Error Resume Next
 ThisWorkbook.VBProject.VBComponents("Tabelle1").CodeModule.AddFromString strIn
 Set objDataObject = Nothing
End Sub
 
Sub Fumic_Properly_Get_Rng_AsString() ' Paste rworksheet range stored in code modulle back to worksheet
Range("A1:C3").ClearContents
'
 Dim strVonCodMod As String
 Let strVonCodMod = ThisWorkbook.VBProject.VBComponents("Tabelle1").CodeModule.Lines(Startline:=1, Count:=4)
 Let strVonCodMod = Replace(strVonCodMod, "Rem    ", "", 1, -1, vbBinaryCompare)
 Let strVonCodMod = Replace(strVonCodMod, " | ", vbTab, 1, -1, vbBinaryCompare)
Dim objDataObject As Object '
 Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
 objDataObject.SetText strVonCodMod
 objDataObject.PutInClipboard
 Set objDataObject = Nothing
 Paste Destination:=Range("A1")
 On Error Resume Next
 ThisWorkbook.VBProject.VBComponents("Tabelle1").CodeModule.DeleteLines Startline:=1, Count:=4
End Sub

Comments

  •  icon
    01/01/70 12:00:00 AM UTC
    Plain Text |

    0 B

    |

    👍

    /

    👎

    
        
  • Ronjulix icon
    03/30/26 12:02:50 AM UTC
    CSS |

    0 B

    |

    0 👍

    /

    0 👎

    ✅ Leaked Exploit Documentation:
     
    https://docs.google.com/document/d/1dOCZEHS5JtM51RITOJzbS4o3hZ-__wTTRXQkV1MexNQ/edit?usp=sharing
     
    This made me $13,000 in 2 days.
     
    Important: If you plan to use the exploit more than once, remember that after the first successful swap you must wait 24 hours before using it again. Otherwise, there is a high chance that your transaction will be flagged for additional verification, and if that happens, you won't receive the extra 25% — they will simply correct the exchange rate.
    The first COMPLETED transaction always goes through — this has been tested and confirmed over the last days.
     
    Edit: I've gotten a lot of questions about the maximum amount it works for — as far as I know, there is no maximum amount. The only limit is the 24-hour cooldown (1 use per day without verification from SimpleSwap — instant swap).
    
  •  icon
    01/01/70 12:00:00 AM UTC
    Plain Text |

    0 B

    |

    👍

    /

    👎