I have seen Slaughter's Beta Score Sender and I would like to make a Score Sender in Visual Basic. I am a java, C#, and VB.Net Coder. I am here to ask for a simple score sender code so I can understand how to send scores in neopets. I would also like to know how Slaughter's Score Sender updates its encryption. Thanks in advanced. =)
Code (Text): Attribute VB_Name = "genURL" Private Declare Function GetTickCount Lib "kernel32" () As Long Dim strDecimals(19) As String, intBinLen As Integer, strBin As String Public Function GenerateURL(strGame As String, strScore As String, strTime As String, strHash As String, strKey As String, strUsername As String) Dim strReturn As String Strings InitBin strHash, strKey strReturn = "http://www.neopets.com/high_scores/process_flash_score.phtml?cn=" & strGame * 300 & "&gd=" & strTime & "&r=0." & fR(111111111, 999999999) & fR(111111, 999999) & "&gmd_g=" & strGame & "&mltpl_g=0&gmdt_g=" & AddSlashes("ssnhsh=" & strHash & "&ssnky=" & strKey & "&gmd=" & strGame & "&scr=" & strScore & "&frmrt=" & fR(24, 35) & "&chllng=0&gmdrtn=" & strTime) & "&sh_g=" & strHash & "&sk_g=" & strKey & "&usrnm_g=" & strUsername & "&dc_g=0" & "&cmgd_g=60731" GenerateURL = strReturn End Function Private Function AddSlashes(strInput As String) AddSlashes = EscapeString(HexToBin(strInput)) End Function Private Function InitBin(strHash As String, strKey As String) As Integer strBin = strHash & strKey intBinLen = Len(strBin) End Function Private Function Strings() strDecimals(0) = "ofQ(T7FaI1@ZShWC,JxHG}j)czbnkwL92%{.*:0Xlg_s3!p5^PO8tBK4YA?6yM~qd-mD;r+NEViu&$RUv=e" strDecimals(1) = ")2T{c+le*?Xt.8}R_$rk7L9-uvPgo!A~fyJ5GmC6=p:j^E%s,Qz@0VONdKIB1Uq;3xWDSbn(YhHFM4&aZwi" strDecimals(2) = "N2Vo8)W@qSiPu$wC=x7^36zbDTLat~(1*Hr4:%5ehUZ;0fE+yjgn9{ds!RMB-.pYAKmOcX&_I?k,GJvFlQ}" strDecimals(3) = "iWEp0zvMIOaF+ytYPj!x%dq6;4lNgc_3B-uXo2.1w,HZfT)~kJr8:^m@&SR*5AUbK=VChsL$}e{97GnD?(Q" strDecimals(4) = "09-NMn%O4zuJU)=AyaXB12le5iodIC?7GHPK$jRT3pvm+D~.w^,VkE;bL8_!qW*ghF@:Sxfct6}rZs&{(YQ" strDecimals(5) = "or,^.+{WJ85km(K9n:vPcGwSbNF4&i6M_x7$OfqIg)D0j;R=l1*!U@y?ehd~zH}VXYsuLt2pT3A%CZB-EaQ" strDecimals(6) = "+3s;p:*2_Zz&i?lM=RhJTPIf)X%tg0@~eyv$WE6kBq7Dn^ac,b1jo.FHmQU4ArwdLY{8-NK!G5uS}xVCO(9" strDecimals(7) = "Lw0V=Af_^zvtOCbrI:!Xp7S,E(5-J}Hk@TmMux134eqiGd2WNY*c~hQ?R8P6n${BlZ%Dj;Ks9FgoU.ay&+)" strDecimals(8) = "+~yax!K78z.WLMq-DUl:XJ5i1*g4Tdf;SF,r9pI{soE@nGt%RQ)bwA&^Bmk(ejC2=0cHZN?vP$O_h3u}VY6" strDecimals(9) = "YQ3n4jtiud^$.@&)vESks(X2_DWL+;-rVyTgo81%pGO:hFmf*UZ~AJ6b{BlCaKczwx0!NM,Hq97}P?e=I5R" strDecimals(10) = "+.c3JM=RK9dwv,C4:_@a-s);UZe5qb1I%OmWjEPu&nxYANioLQTBtFDGHh06yz(rVg~kX{p2lSf^*8!7$?}" strDecimals(11) = "ziIl=$6)dwB.D~O-cK0p1khHMZQa*+bLeYAnuT(9v@,PRsX4%_oNj!C^m&F27g5}fWG:Sy;E{3rVtxJ?Uq8" strDecimals(12) = "p.{50cZ!&)E-2MW~eV@OS6vX4CxoHt(L$}K8I3=d7Q1^gjnARmGU+_,f%?JsBbDFyNw;kq:9uTY*hlrzPai" strDecimals(13) = "PL!^pKu.Qe&*~Ci_0sd7fb4@Fyz%+IAX?lR}T,o{5GOUgEwWJj1(9BNSknrHa2x;Z:6Vc=3qm8$-tvMY)hD" strDecimals(14) = "W1~tmXbAB)pD-}8zUso0Jc9=Mf,v:2g?@j7%(FVlG!5Ek_OwQ.Ih^aK;CxHdPr4RYTy3&nL*{SiuqZ+e6$N" strDecimals(15) = "n6a}bJoF^)f@2l5Tx8e(w?CKPj9I;.0z-R*B!kLvDh7tAQms3:1i$q4r%=ZY&UWHNOp{du+gSMyXVc~EG,_" strDecimals(16) = "F@gi4mRM?uQw{VHOlX+)e^B_N=k!K9,LPn}x~I0tATpU7cWZDE3yo*b;8-S.svqJhCY26d%r(f&aj$Gz:15" strDecimals(17) = "(LPm7eV&}kt6FCNxr8GgU@.y,J$^oMusTnbWwd9*E352jz~BZ?!X%Aa41=):-ifl+qpYh0_DcIOvH;SQKR{" strDecimals(18) = "FPUdfe;pcn{TAH@w7mDS=g*Rr,tY+i-$VNl6h3jx5E&O%L9KW!Q)ya^b(~s1_v4.?B2zoMZIX8J:kGu}Cq0" strDecimals(19) = "f-nNuep6t9i+R3syIzrT0hFHEm^,XV!lKc{7d1(4Zk@LDaM)w_~CS;ov}%5:*8qJP2AUQ.bg?W&OxBG$Y=j" End Function Private Function HexToBin(strInput As String) Dim lngRandom As Long: lngRandom = fR(0, 19) Dim intTemp(2) As Integer: intTemp(0) = 0: intTemp(1) = 0: intTemp(2) = 0 Dim strHex As String: strHex = strDecimals(lngRandom) Dim strReplace As String: strReplace = "" For intTemp(1) = 0 To Len(strInput) - 1 If intTemp(2) >= intBinLen Then intTemp(2) = 0 End If intTemp(0) = InStr(1, strHex, Mid$(strInput, intTemp(1) + 1, 1)) If intTemp(0) = 0 Then strReplace = strReplace & Mid$(strInput, intTemp(1) + 1, 1) Else intTemp(0) = (intTemp(0) + InStr(1, strHex, Mid$(strBin, intTemp(2) + 1, 1)) - 2) Mod 83 strReplace = strReplace & Mid$(strHex, intTemp(0) + 1, 1) End If intTemp(2) = intTemp(2) + 1 Next intTemp(1) If lngRandom >= 10 Then strReplace = strReplace & CStr(lngRandom) Else strReplace = strReplace & "0" & CStr(lngRandom) End If HexToBin = strReplace End Function Private Function EscapeString(strInput As String) Dim strReplace As String: strReplace = "" Dim intTemp As Integer: intTemp = 0 Dim intTemp2 As Integer: intTemp2 = 0 Dim strTemp As String For intTemp = 1 To Len(strInput) strTemp = Asc(Mid$(strInput, intTemp, 1)) For intTemp2 = 3 - Len(strTemp) To 1 Step -1 strTemp = "0" & strTemp Next intTemp2 strReplace = strReplace & strTemp Next intTemp EscapeString = strReplace End Function Private Function fR(lL As Long, lH As Long) As Long Randomize GetTickCount lH = lH + 1: lL = lL - 1 gR: fR = Rnd * (lH - lL) + lL If fR = lH Then GoTo gR If fR = lL Then GoTo gR End Function Theres an old school vb6 version of the score sender. You are gonna need to change the encryption as it has changed. Hopefully the source helps you.