Jump to content

Batch User

Member
  • Posts

    28
  • Joined

  • Last visited

  • Donations

    0.00 USD 
  • Country

    United States

About Batch User

Batch User's Achievements

0

Reputation

  1. I apologize for the inconvenience. Public Const title = "Clan Check by AwaKening"' // Title for default new Registrations to forum Public Const fm = "Forum Member" '// Title for Clan Members Public Const cm = "Clan RnR" Public Const forum = "http://clanrnr.com/index.php?act=Members" Public Const bnet = "http://www.battle.net/war3/ladder/w3xp-clan-profile.aspx?Gateway=Lordaeron&ClanTag=RnR" Dim oDict, INet1 Set INet1 = CreateObject("Microsoft.XmlHttp") Set oDict = CreateObject("Scripting.Dictionary") oDict.CompareMode = 1 Call ClanCheck() Sub ClanCheck() Dim inclan, content, i, pages, users, n, name content = INet1.openUrl(bnet) If InStr(content,"Error Encountered")>1 Then MsgBox "Error! The Battle.net clan page was unreachable." Exit Sub End If inclan = Mid(content,Instr(content,"Total Members:")) inclan= Split(inclan,">")(5) inclan = Left(inclan,2) i = Int(inclan) pages = Int(i/15) If i Mod 15 > 0 Then pages=pages+1 End If For n=1 to pages content = INet1.OpenURL(bnet & "&pageno=" & n) users=split(content,"PlayerName=") users=split(content,"PlayerName=") name=Left(users(i),InStr(users(i),">")-2) name = Replace(name,"%5b","[") name = Replace(name,"%5d","]") oDict.Add name, i Next Next Call ForumCheck() End Sub Sub ForumCheck() Dim i, n, content, pages, names, name, status, unregistered, remove, add content = INet1.OpenURL(forum) pages = 0 If InStr(content, "Pages:</a> (") > 0 Then pages = Int(Left(Split(content, "Pages:</a> (")(1),1)) End If For i=0 to pages content = INet1.OpenURL(forum & "&st=" & i) names = Split(content,"<strong><a href=") For n=0 to UBound(names) name = Split(Split(names, ">")(1),"<")(0) status = Split(Split(names, ">")(8),"<")(0) If oDict.Exists(name) Then If status = fm Then add = name & ", " End If oDict.Remove name ElseIf status = cm Then remove = name & ", End If Next Next If oDict.Count > 0 Then For each k in oDict.Keys unregistered = k & ", " Next unregistered = Left(unregistered, Len(unregistered)-2) MsgBox "Unregistered members: " & unregistered End If If add <> vbNullString Then add = Left(add, Len(add)-2) MsgBox "Change the following members to " & cm & ": " & add End If If remove <> vbNullString Then remove = Left(remove, Len(remove)-2) MsgBox "Change the following to " & fm & ": " & remove End If End Sub
  2. There is a game and there is a bot for the game that you can design VBS scripts to work. I know you don't know how the bot works but you may be able to help with this. Simple vbscript to check forum members against site, but I'm having trouble with Inet. Someone help me to parse a site? I get an error with .openurl CODEPublic Const title = "Clan Check by AwaKening"'// Title for default new Registrations to forumPublic Const fm = "Forum Member"'// Title for Clan MembersPublic Const cm = "Clan RnR"Public Const forum = "http://clanrnr.com/index.php?act=Members"Public Const bnet = "http://www.battle.net/war3/ladder/w3xp-clan-profile.aspx?Gateway=Lordaeron&ClanTag=RnR"Dim oDict, INet1Set INet1 = CreateObject("Microsoft.XmlHttp")Set oDict = CreateObject("Scripting.Dictionary")oDict.CompareMode = 1Call ClanCheck()Sub ClanCheck() Dim inclan, content, i, pages, users, n, name content = INet1.openUrl(bnet) If InStr(content,"Error Encountered")>1 Then MsgBox "Error! The Battle.net clan page was unreachable." Exit Sub End If inclan = Mid(content,Instr(content,"Total Members:")) inclan= Split(inclan,">")(5) inclan = Left(inclan,2) i = Int(inclan) pages = Int(i/15) If i Mod 15 > 0 Then pages=pages+1 End If For n=1 to pages content = INet1.OpenURL(bnet & "&pageno=" & n) users=split(content,"PlayerName=") For i=1 to ubound(users) name=Left(users(i),InStr(users(i),">")-2) name = Replace(name,"%5b","[") name = Replace(name,"%5d","]") oDict.Add name, i Next Next Call ForumCheck()End SubSub ForumCheck() Dim i, n, content, pages, names, name, status, unregistered, remove, add content = INet1.OpenURL(forum) pages = 0 If InStr(content, "Pages:</a> (") > 0 Then pages = Int(Left(Split(content, "Pages:</a> (")(1),1)) End If For i=0 to pages content = INet1.OpenURL(forum & "&st=" & i) names = Split(content,"<strong><a href=") For n=0 to UBound(names) name = Split(Split(names, ">")(1),"<")(0) status = Split(Split(names, ">")(8),"<")(0) If oDict.Exists(name) Then If status = fm Then add = name & ", " End If oDict.Remove name ElseIf status = cm Then remove = name & ", " End If Next Next If oDict.Count > 0 Then For each k in oDict.Keys unregistered = k & ", " Next unregistered = Left(unregistered, Len(unregistered)-2) MsgBox "Unregistered members: " & unregistered End If If add <> vbNullString Then add = Left(add, Len(add)-2) MsgBox "Change the following members to " & cm & ": " & add End If If remove <> vbNullString Then remove = Left(remove, Len(remove)-2) MsgBox "Change the following to " & fm & ": " & remove End If End Sub Also, I spotted a couple of other errors, but just look past them for now. I just need Inet working. <Edit> Code tags now replaced by codebox in order to help with browser layout formatting </Edit>
  3. This is a project I'm currently working on. It really has no use just thought it would be fun. As you may notice I have a 'create' button that allows me to create a text document. But the thing is every time you load the program you need to create a new text document. I wondering if anyone can help me out with a 'load' button that would load a .txt file. thanks. CODE Dim position As Integer Structure person Public ID As Integer <VBFixedString(15)> Public name As String <VBFixedString(15)> Public surname As String End Structure Dim list(44) As person Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim RecLength As Long, Employee As person Dim filenum As Integer filenum = FreeFile() FileOpen(filenum, TextBox1.Text, OpenMode.Random, , , Len(Employee)) FileClose(filenum) End Sub Function FindLastRecordNo() As Integer Dim temp As person, filenumber As Integer filenumber = FreeFile() FileOpen(filenumber, TextBox1.Text, OpenMode.Random, OpenAccess.Read, , Len(temp)) FindLastRecordNo = 1 Do While Not EOF(filenumber) FileGet(filenumber, temp, ) FindLastRecordNo = FindLastRecordNo + 1 Loop FileClose(filenumber) End Function Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click Dim Employee As person, lastrecord As Integer Dim filenum As Integer lastrecord = FindLastRecordNo() filenum = FreeFile() FileOpen(filenum, TextBox1.Text, OpenMode.Random, , , Len(Employee)) Employee.ID = Val(TextBox2.Text) Employee.name = TextBox3.Text Employee.surname = TextBox4.Text FilePut(filenum, Employee, lastrecord) FileClose(filenum) End Sub Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click Dim filenum As Integer Dim employee As person, count As Integer, Temp As String filenum = FreeFile() FileOpen(filenum, "D:\school\test4.txt", OpenMode.Random, , , Len(employee)) count = 1 ListBox1.Items.Clear() Do While Not EOF(filenum) FileGet(filenum, employee, count) Temp = Str(employee.ID) + " " + employee.name + " " + employee.surname ListBox1.Items.Add(Temp) count = count + 1 Loop FileClose(filenum) End Sub Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click Dim filenum As Integer Dim employee As person filenum = FreeFile() FileOpen(filenum, TextBox1.Text, OpenMode.Random, , , Len(employee)) Do While Not EOF(filenum) FileGet(filenum, employee, ) If employee.ID = Val(TextBox5.Text) Then position = Loc(filenum) TextBox5.Enabled = False TextBox6.Enabled = True TextBox7.Enabled = True Button4.Enabled = False Button5.Enabled = True Button6.Enabled = True TextBox6.Text = employee.name TextBox7.Text = employee.surname Exit Do End If Loop FileClose(filenum) End Sub Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click Dim filenum As Integer Dim employee As person filenum = FreeFile() FileOpen(filenum, TextBox1.Text, OpenMode.Random, , , Len(employee)) Seek(filenum, position) employee.ID = Val(TextBox5.Text) employee.name = TextBox6.Text employee.surname = TextBox7.Text FilePut(filenum, employee, ) FileClose(filenum) TextBox5.Enabled = True TextBox6.Enabled = False TextBox7.Enabled = False Button4.Enabled = False Button5.Enabled = True Button6.Enabled = False TextBox5.Text = "" TextBox6.Text = "" TextBox7.Text = "" End Sub Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click Dim filenum As Integer Dim employee As person, filenum1, filenum2 As Integer filenum1 = FreeFile() FileOpen(filenum1, TextBox1.Text, OpenMode.Random, OpenAccess.Read, , Len(employee)) filenum2 = FreeFile() FileOpen(filenum2, "temp.text", OpenMode.Random, OpenAccess.Write, , Len(employee)) Do While Not EOF(filenum1) If (Loc(filenum1) <> position - 1) Then FileGet(filenum1, employee, ) FilePut(filenum2, employee, ) Else FileGet(filenum1, employee, ) End If Loop FileClose(filenum1) FileClose(filenum2) Kill(TextBox1.Text) Rename("text.txt", TextBox1.Text) TextBox5.Enabled = True TextBox6.Enabled = False TextBox7.Enabled = False Button4.Enabled = False Button5.Enabled = True Button6.Enabled = False TextBox5.Text = "" TextBox6.Text = "" TextBox7.Text = "" End Sub Private Sub swap_them(ByRef number1 As person, ByRef number2 As person) Dim temp As person temp = number1 number1 = number2 number2 = temp End Sub Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click Dim filenum As Integer Dim i, j As Integer Dim employee As person, count, counter As Integer, temp As String filenum = FreeFile() FileOpen(filenum, TextBox1.Text, OpenMode.Random, , , Len(employee)) count = 1 ListBox2.Items.Clear() Do While Not EOF(filenum) FileGet(filenum, employee, count) list(count).ID = Val(employee.ID) list(count).name = employee.name list(count).surname = employee.surname count = count + 1 Loop FileClose(filenum) For counter = 1 To count ListBox2.Items.Add(Str(list(counter).ID) + " " + list(counter).name + " " + list(counter).surname) Next For i = 1 To count For j = 2 To count If list(j).ID < list(j - 1).ID Then swap_them(list(j), list(j - 1)) Next Next ListBox2.Items.Add("****Numeric Order****") For counter = 1 To count ListBox2.Items.Add(Str(list(counter).ID) + " " + list(counter).name + " " + list(counter).surname) Next End Sub Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load TextBox1.Clear() TextBox2.Clear() TextBox3.Clear() TextBox4.Clear() TextBox5.Clear() TextBox6.Clear() TextBox7.Clear() End Sub End Class
  4. Well, i'm trying to create a program, i start off with the basics of course but before i even start on the thing i want to make i want to make sure its possible. I want to know if there is a colour finding procedure I want to know if there is a procedure that controls your mouse (To a color) and keyboard.
  5. I am writing another removal tool using Visual Basic and this virus loads as a service and protects it self. It can not be shutdown via safemode nor can it be via services.msc. So I need to make something that can kill this service. Does anyone know how I would go about writing it to kill a PROTECTED service? And no, setting the process token to SeDebugPriveledges does not help.
  6. How do i use Set oWsh = CreateObject("WScript.Shell") to run a .exe, because I know for some reason the path is different... or something. oWsh.Run "C:\path" Doesnt work.. Thanks.
  7. I do not want to have that very stupid to look at the readme for my browser so i have decided to make it an online readme just like you have here but i dont know what the code should be. CODEPrivate Sub mnuHelpContents_Click() On Error Resume Next Dim nRet As Integer nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0) If Err Then MsgBox Err.Description End If End Sub Thats what i have now.
  8. Okay look at my site: www.berzerkerweb.com You see the site tab links? When you hover over them they turn lighter blue instantly. How do I go about making them fade to the blue? Heres half of a fade code I started and then I got lost.. <script language="JavaScript1.2"> function high(which2){ theobject=which2 highlighting=setInterval("highlightit(theobject)",50) } function low(which2){ clearInterval(highlighting) if (which2.style.MozOpacity) which2.style.MozOpacity=0.3 else if (which2.filters) which2.filters.alpha.opacity=40 } function highlightit(cur2){ if (cur2.style.MozOpacity<1) cur2.style.MozOpacity=parseFloat(cur2.style.MozOpacity)+0.1 else if (cur2.filters&&cur2.filters.alpha.opacity<100) cur2.filters.alpha.opacity+=10 else if (window.highlighting) clearInterval(highlighting) } </script> This will go in the actual link code.. style="filter:alpha(opacity=40);-moz-opacity:0.3" onMouseover="high(this)" onMouseout="low(this)"
  9. I've actually got a blog code, but I just need someone to spice it up to how I want it.
  10. What I need is someone to create a script for me that lets you login/register for the blog as well. This project is way to hard for me. I can't code hardly at all. I've actually got the blog code for myspace. If someone could just edit the code for me to what I want wouldn't be much work at all!
  11. Yes, but people will, in a sense have their own 'blog' on the site, but instead they will be posting prose / poetry / lyrics, whatever, in our database. It's basicly when you click the members name it brings you to a page, like on these forums, and on the page is there work of art. Is there anybody who can do this? The 1 thing that I mainly need is just a blog and a login/register button. If someone could just do that, depending on how useful it is depends on how much the pay. But really, I need someone to please do it. The site is going to be a myspace/xanga. Advertisments will be put up as soon as we get someone to do the job so the site can be finished. It's going to be a popular site once everything is done.
×
×
  • Create New...