├── Chaturbate Recorder.exe
├── README.md
├── Recorder.hta
└── Source Code
    ├── Form1.frm
    ├── Gallery.frm
    ├── Module1.bas
    ├── Module2.bas
    ├── Module3.bas
    ├── Module4.bas
    ├── Project1.vbp
    ├── Project1.vbw
    ├── RunningRecorders.frm
    ├── RunningRecorders.frx
    ├── modCollections.bas
    ├── modEnums.bas
    └── modTypes.bas


/Chaturbate Recorder.exe:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/2MinhetNguyles/Chaturbate-Recorder-GUI/4f6cde34e4a36ead18d5edc300be9a0407237e5b/Chaturbate Recorder.exe


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # Chaturbate-Recorder-GUI (.EXE)
 2 | Chaturbate Recorder GUI for FFMpeg
 3 | 
 4 | Update: November 2019, chaturbate has subtly changed their stream URL (well looks like they tried to hide it)... the necessary adjustments have been made. Will upload source at a later date.
 5 | 
 6 | Requirements:
 7 |   *Windows only! Written and tested on Windows 10
 8 |   *FFMpeg
 9 | 
10 | Instructions:
11 |   1. Download and extract FFMpeg to a folder.
12 |   2. Download Chaturbate Recorder.exe and place it in the FFMpeg folder.
13 |   3. Run the exe file.
14 |   4. Copy the URL of the model you want to record in to the GUI.
15 |   5. Click get stream address, wait a couple of seconds, if it is successful the address will appear in the box below.
16 |   6. Click on start FFMpeg to begin recording.
17 | 
18 | Features:
19 |   - This was written using VB6.0, so it will natively work in windows out of the box without any ****ing around.
20 |   - Record stream from an input URL.
21 |   - Recordings are automatically named by the model name and the date stamp in the .\recordings folder.
22 |   - Favourites list implemented.
23 |   - Check for what favourites are currently online.
24 |   - Preview stream button & functionality.
25 |   -ffmpeg window is hidden after recording is started (you can unhide it from the running recorders screen).
26 |   -The new video gallery will also sort all of you recordings into models and allow you to view them.
27 | 
28 | FAQS:
29 |   - Q.Why VB6.0 and not some other curley brace language.
30 |   A.Short answer, I am very familiar with VB and VB variants (6.0 being my favourite.)
31 |   A.Opinionated answer, curley brace languages suck dick.
32 |     
33 |   - Q. The stream suddenly stopped recording?
34 |   A. This is a GUI for FFMpeg not a recorder, the model has probably gone offline/switched to private show and thus the stream has dropped out (the stream address actually changes when this happens too). Also it does require a fairly large amount of bandwidth to stream and capture.
35 |     
36 |   - Q.What IDE did you use?
37 |   A.Microsoft Visual Basic 6.0
38 |   
39 |   - Q. Are you going to release the source code?
40 |     A. Y̶e̶s̶,̶ ̶e̶v̶e̶n̶t̶u̶a̶l̶l̶y̶.̶.̶.̶.̶ ̶w̶h̶e̶n̶ ̶I̶ ̶c̶a̶n̶ ̶b̶e̶ ̶b̶o̶t̶h̶e̶r̶e̶d̶.̶
41 |     A. Yes, it is now released into the wild. Go forth and multiply.
42 | 
43 | 
44 | 
45 | 
46 | 
47 | 
48 | 
49 | 
50 | 
51 | 
52 | 
53 | # Chaturbate-Recorder-GUI-HTA (OBSOLETE)
54 | This is not a recorder it is a GUI for recording using FFMpeg
55 | 
56 | Requirements:
57 |   *Windows only! Written and tested on Windows 10
58 |   *FFMpeg
59 | 
60 | Instructions:
61 |   1. Download and extract FFMpeg to a folder.
62 |   2. Download recorder.hta and place it in the FFMpeg folder.
63 |   3. Open the HTA file.
64 |   4. Copy the URL of the model you want to record in to the GUI.
65 |   5. Click get stream address, wait a couple of seconds, if it is successful the address will appear in the box below.
66 |   6. Click on start FFMpeg to begin recording.
67 |   
68 | Features:
69 |   - This was written using VBScript & MSHTA, so it will natively work in windows out of the box without any ****ing around.
70 |   - Record stream from an input URL.
71 |   - Recordings are automatically named by the model name and the date stamp in the .\recordings folder.
72 |   - Favourites list implemented.
73 |   - Preview stream button (so far only when selecting something in the favourites list).
74 |   
75 |   
76 | Future Wish List: 
77 |   - Online / Offline models list.
78 |   - I'll think of more later.
79 |   
80 |   
81 | FAQS:
82 |   - Q.Why VBScript and not JavaScript?
83 |   - A.I am more familiar with VBScript, but if someone wants to convert go ahead, shouldn't be too difficult.
84 |     
85 |   - Q. The stream suddenly stopped recording?
86 |   - A. This is a GUI for FFMpeg not a recorder, the model has probably gone offline/switched to private show and thus the stream has dropped out (the stream address actually changes when this happens too).
87 |     
88 |   - Q.What IDE did you use?
89 |   - A.HTAEDIT
90 |     
91 | 


--------------------------------------------------------------------------------
/Recorder.hta:
--------------------------------------------------------------------------------
  1 | <html>
  2 | <head>
  3 | <title>Chaturbate FFmpeg Recorder Interface by: 2MinhetNguyles</title>
  4 | <HTA:APPLICATION
  5 |   APPLICATIONNAME="Chaturbate FFmpeg Recorder Interface by: 2MinhetNguyles"
  6 |   ID="CbFFmpegRec"
  7 |   VERSION="1.0"/>
  8 | </head>
  9 | 
 10 | <script language="VBScript">
 11 | 
 12 | Sub Window_OnLoad
 13 | 	Dim objShell: Set objShell = CreateObject("WScript.Shell")
 14 | 	Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
 15 | 	
 16 | 	window.resizeTo 650,700
 17 | 	
 18 | 	If Not objFSO.FileExists(objShell.CurrentDirectory & "\ffmpeg.exe") Then
 19 | 		overWorld.innerHtml = "FFMpeg not detected! Please place this file in the same directory as FFMpeg.exe and run it again!<p><b><a href='https://www.ffmpeg.org/download.html'>Download Here</a>"
 20 | 		Exit Sub
 21 | 	End If
 22 | 	
 23 | 	If Not objFSO.FolderExists(objShell.CurrentDirectory & "\Recordings") Then
 24 | 		objFSO.CreateFolder(objShell.CurrentDirectory & "\Recordings")
 25 | 	End If
 26 | 	
 27 | 	Call readFavourites
 28 | 
 29 | End Sub
 30 | 
 31 | 
 32 | 
 33 | '**************Functions**************
 34 | 
 35 | 'Sorts an input array
 36 | Function arrSort(inputArray, sortAscending)
 37 | 	Dim objArray: Set objArray = CreateObject("System.Collections.ArrayList")
 38 | 	Dim tempArray
 39 | 	Dim i, x
 40 | 	
 41 | 	For i = 0 To UBound(inputArray)
 42 | 		objArray.Add inputArray(i)
 43 | 	Next
 44 | 	
 45 | 	objArray.Sort()
 46 | 	If Not sortAscending Then objArray.Reverse()
 47 | 	
 48 | 	ReDim tempArray(objArray.Count-1)
 49 | 	
 50 | 	i = 0
 51 | 	For Each x in objArray
 52 | 		tempArray(i) = x
 53 | 		i = i + 1
 54 | 	Next
 55 | 	
 56 | 	arrSort = tempArray
 57 | 	
 58 | End Function
 59 | 
 60 | 
 61 | 'Removes element from array
 62 | Function arrRemove(inputArray, elementToRemove)
 63 | 	Dim objArray: Set objArray = CreateObject("System.Collections.ArrayList")
 64 | 	Dim tempArray
 65 | 	Dim i, x, o
 66 | 	
 67 | 	For i = 0 To UBound(inputArray)
 68 | 	
 69 | 		If inputArray(i) <> elementToRemove Then
 70 | 			objArray.Add inputArray(i)
 71 | 		Else
 72 | 		End If
 73 | 	Next
 74 | 	
 75 | 	ReDim tempArray(objArray.Count-1)
 76 | 	
 77 | 	i = 0
 78 | 	For Each x in objArray
 79 | 		tempArray(i) = x
 80 | 		i = i + 1
 81 | 	Next
 82 | 	
 83 | 	arrRemove = tempArray
 84 | 	
 85 | End Function
 86 | 
 87 | 
 88 | 'Creates a listbox at a spanID from an array.
 89 | Function createListBox(listName, inputArray)
 90 | 
 91 | 	Dim spanHtml
 92 | 	Dim i
 93 | 	
 94 | 	spanHtml = "<select name='" & listName & "' id='" & listName & "' size=" & UBound(inputArray)+1 & ">"
 95 | 	For i = 1 To UBound(inputArray)+1
 96 | 		spanHtml = spanHtml & "<option value='" & i & "'>" & inputArray(i-1) & "</option>"
 97 | 	Next
 98 | 	spanHtml = spanHtml & "</select>"
 99 | 	
100 | 	createListBox = spanHtml
101 | 
102 | End Function
103 | 
104 | 
105 | 'Returns the value of the selected item in favList
106 | Function getFavListSelection
107 | 	On Error Resume Next
108 | 	Dim x
109 | 
110 | 	For Each x in favList.Options
111 |     	If x.Selected Then
112 |         	getFavListSelection = x.innerHtml
113 |         End If
114 |     Next
115 | 
116 | End Function
117 | 
118 | 
119 | 'Returns the HTML source of a webpage.
120 | Function getHTML(address)
121 | 	Dim objXmlHttp: Set objXmlHttp = createobject("MSXML2.XMLHTTP.6.0")
122 | 	
123 | 	objXmlHttp.open "get", address
124 | 	objXmlHttp.send
125 | 	getHTML = objXmlHttp.responseText
126 | 
127 | End Function
128 | 
129 | 
130 | 'Figures out the output name of the stream to be recorded
131 | Function getOutputName()
132 | 	Dim objShell: Set objShell = CreateObject("WScript.Shell")
133 | 	Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
134 | 	Dim outputName
135 | 	Dim i
136 | 	
137 | 	outputName = Right(cbAddress.Value, Len(cbAddress.value) - 23)
138 | 	outputName = Replace(outputName,"/","")
139 | 	outputName = outputName & " " & Replace(Now(),"/","-")
140 | 	outputName = Replace(outputName,":",".")
141 | 	outputName = outputName & ".mp4"
142 | 	
143 | 	getOutputName = outputName
144 | 	
145 | End Function
146 | 
147 | 
148 | 'Reads every line of a text file and returns as a 0 based array.
149 | Function readTextFile(filePath)
150 | 	Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
151 | 	Dim objFile: Set objFile = objFSO.OpenTextFile(filePath)
152 | 	Dim arrTemp, i
153 | 	
154 | 	arrTemp = Array()
155 | 	
156 | 	'readTextFile = Split(objFile.ReadAll,vbCrLf)
157 | 	
158 | 	i = 0
159 | 	Do Until objFile.AtEndOfStream
160 | 		ReDim Preserve arrTemp(i)
161 |   		arrTemp(i) = objFile.ReadLine
162 |   		i = i +1
163 | 	Loop
164 | 	
165 | 	readTextFile = arrTemp
166 | 	
167 | 	objFile.Close
168 | 	
169 | End Function
170 | 
171 | 
172 | 'Removes duplicates from an input array.
173 | 'Reused from some message board, forgot to add link.
174 | Public Function RemoveDuplicate(byVal arrDuplicate())
175 | 	Dim sdScriptingDictionary, Item, arrReturn
176 | 	
177 | 	Set sdScriptingDictionary = CreateObject("Scripting.Dictionary")
178 | 	sdScriptingDictionary.RemoveAll
179 | 	sdScriptingDictionary.CompareMode = BinaryCompare
180 | 	For Each Item In arrDuplicate
181 | 	    'If item does not exist in dictionary d then add it
182 | 	    If Not sdScriptingDictionary.Exists(Item) Then sdScriptingDictionary.Add Item, Item
183 | 	    'If Not sdScriptingDictionary.Exists(item) Then
184 | 	        'sdScriptingDictionary.Remove(item)
185 | 	    'End If
186 | 	Next
187 | 	arrReturn = sdScriptingDictionary.keys
188 | 	
189 | 	'Clean Up
190 | 	Erase arrDuplicate
191 | 	Set arrDuplicate = Nothing
192 | 	
193 | 	sdScriptingDictionary.RemoveAll
194 | 	Set sdScriptingDictionary = Nothing
195 | 	
196 | 	RemoveDuplicate = arrReturn
197 | End Function
198 | 
199 | 
200 | 'Writes values from an array to a file
201 | Function writeToTextFile(filePath, inputArray, delimiter)
202 | 	Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
203 | 	Dim objFile: Set objFile = objFSO.OpenTextFile(filePath, 2)
204 | 	Dim i
205 | 	
206 | 	For i = 0 To UBound(inputArray)
207 | 		objFile.Write inputArray(i) & delimiter
208 | 	Next
209 | 	
210 | 	objFile.Close
211 | 	
212 | End Function
213 | 
214 | 
215 | 
216 | '**************End Of Functions**************
217 | 
218 | 
219 | 
220 | '**************Subroutines**************
221 | 
222 | 'Forcefully kill a task by image name
223 | 'Call killTask("Program.exe")
224 | Sub killtask(ImageName)
225 | 	Dim objShell : Set objShell = CreateObject("WScript.Shell")
226 | 	objShell.Run "taskkill /f /im " & Chr(34) & ImageName & Chr(34)
227 | End Sub
228 | 
229 | 
230 | 'For reading Favourites file
231 | Sub readFavourites
232 | 
233 | 	Dim objShell: Set objShell = CreateObject("WScript.Shell")
234 | 	Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
235 | 	Dim arrayTemp
236 | 	
237 | 	'If no favourites file present
238 | 	If Not objFSO.FileExists(objShell.CurrentDirectory & "\Favourites.txt") Then
239 | 		objFSO.CreateTextFile(objShell.CurrentDirectory & "\Favourites.txt")
240 | 	End If
241 | 	
242 | 	arrayTemp = readTextFile(objShell.CurrentDirectory & "\Favourites.txt")
243 | 	arrayTemp = arrSort(arrayTemp, True)
244 | 	arrayTemp = RemoveDuplicate(arrayTemp)
245 | 	
246 | 	spanList.innerHtml = createListBox("favList", arrayTemp)
247 | 
248 | End Sub
249 | 
250 | 
251 | 'WScript.Sleep workaround for HTA
252 | 'Call Sleep(1000)
253 | Sub Sleep(MilliSeconds)
254 | 	Dim objShell : Set objShell = CreateObject("WScript.Shell")
255 |     objShell.Run "Timeout /T " & MilliSeconds/1000 & " /nobreak" ,0 ,True   
256 | End Sub
257 | 
258 | '**************End Of Subroutines**************
259 | 
260 | 
261 | 
262 | 
263 | '**************GUI Controls**************
264 | 
265 | Sub OnClickButtongetM38U()
266 | 	Dim modelHtml
267 | 
268 | 	modelHtml = getHTML(cbAddress.Value)
269 | 	
270 | 	'Format Address
271 | 	modelHtml = Left(modelHtml,InStr(modelHtml,".m3u8")+4)
272 | 	modelHtml = Right(modelHtml, Len(modelHtml)-InStr(modelHtml,"https://edge")+1)
273 | 	
274 | 	If Len(modelHtml) < 20 Then
275 | 		modelHtml = ""
276 | 		MsgBox "Sorry, the model is offline or does not exist!"
277 | 	End If
278 | 	
279 | 	information.Value = modelHtml
280 | 	
281 | End Sub
282 | 
283 | 
284 | 'Clears the input box and stream info.
285 | Sub OnClickButtonclearInput()
286 | 	cbAddress.Value = ""
287 | 	information.Value = ""
288 | End Sub
289 | 
290 | 
291 | Sub OnClickButtonstartFFmpeg()
292 | 	Dim objShell: Set objShell = CreateObject("WScript.Shell")
293 | 
294 | 	If Len(information.value) < 20 Then
295 | 		MsgBox "You need to get a stream address first!"
296 | 	End If
297 | 	objShell.Run "ffmpeg -i " & information.value & " -acodec copy -vcodec copy " & Chr(34) & ".\Recordings\" & getOutputName & Chr(34)
298 | 	'objShell.Run "ffmpeg -i " & information.value & " -c copy -bsf:a aac_adtstoasc " & Chr(34) & ".\Recordings\" & getOutputName & Chr(34)
299 | End Sub
300 | 
301 | 
302 | 'Adds the current input model to the favourites list.
303 | Sub OnClickButtonaddFav()
304 | 	Dim objShell: Set objShell = CreateObject("WScript.Shell")
305 | 	Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
306 | 	Dim newEntry, arrayTemp, arLn
307 | 	Dim i
308 | 	
309 | 	If Len(cbAddress.Value) < 15 Then
310 | 		MsgBox "Model address invalid!"
311 | 		Exit Sub
312 | 	End If
313 | 	
314 | 	newEntry = Right(cbAddress.Value, Len(cbAddress.value) - 23)
315 | 	newEntry = Replace(newEntry,"/","")
316 | 	
317 | 	If Not objFSO.FileExists(objShell.CurrentDirectory & "\Favourites.txt") Then
318 | 		objShell.Run "cmd.exe /c echo " & newEntry & " >> " & Chr(34) & objShell.CurrentDirectory & "\Favourites.txt" & Chr(34)
319 | 		Exit Sub
320 | 	End If
321 | 	
322 | 	arrayTemp = readTextFile(objShell.CurrentDirectory & "\Favourites.txt")
323 | 	arLn = UBound(arrayTemp)+1
324 | 	ReDim Preserve arrayTemp(arLn)
325 | 	arrayTemp(arLn) = newEntry
326 | 	arrayTemp = arrSort(arrayTemp, True)
327 | 	
328 | 	arrayTemp = RemoveDuplicate(arrayTemp)
329 | 	
330 | 	Call writeToTextFile(objShell.CurrentDirectory & "\Favourites.txt",arrayTemp, VbCrLf)
331 | 	Call readFavourites
332 | 	
333 | End Sub
334 | 
335 | 
336 | 'Removes the selected model from favourites list.
337 | Sub OnClickButtonremFav()
338 | 	Dim objShell: Set objShell = CreateObject("WScript.Shell")
339 | 	Dim arrayTemp
340 | 	
341 | 	arrayTemp = readTextFile(objShell.CurrentDirectory & "\Favourites.txt")
342 | 	arrayTemp = arrSort(arrayTemp, True)
343 | 	arrayTemp = RemoveDuplicate(arrayTemp)
344 | 	arrayTemp = arrRemove(arrayTemp, getFavListSelection)
345 | 	
346 | 	Call writeToTextFile(objShell.CurrentDirectory & "\Favourites.txt",arrayTemp, VbCrLf)
347 | 	Call readFavourites
348 | 	
349 | End Sub
350 | 
351 | 
352 | 'Gets the stream for the selected model on the favourites list.
353 | Sub OnClickButtongetFavModel()
354 | 	cbAddress.Value = ""
355 | 	information.Value = ""
356 | 	cbAddress.Value = "https://chaturbate.com/" & getFavListSelection & "/"
357 | 	getM38U.Click
358 | 	
359 | End Sub
360 | 
361 | 
362 | Sub OnClickButtonprevStream()
363 | 	cbAddress.Value = ""
364 | 	information.Value = ""
365 | 	cbAddress.Value = "https://chaturbate.com/" & getFavListSelection & "/"
366 | 	getM38U.Click
367 | 	
368 | 	If Len(Information.Value) > 10 Then
369 | 		vidPreview.innerHtml = "<embed src='" & information.Value & "' width='720' height='480' autostart='true' type='video/mp4'>"
370 | 	End If
371 | 	
372 | End Sub
373 | 
374 | 
375 | Sub OnClickButtonvidPreviewClose()
376 | 	vidPreview.innerHtml = ""
377 | End Sub
378 | 
379 | '**************End Of GUI Controls**************
380 | 
381 | </script>
382 | 
383 | <body bgcolor="#d0c0c8">
384 | <span id="overWorld">
385 | <!--Add your controls here-->
386 | <input type="button" name="getM38U" id="getM38U" value="Get Stream Address" onclick="OnClickButtongetM38U">
387 | <input type="button" name="startFFmpeg" id="startFFmpeg" value="Start FFmpeg" onclick="OnClickButtonstartFFmpeg">
388 | <b><p>
389 | <span>Please Enter The Model URL Below:</span>
390 | <b><p>
391 | <input type="text" name="cbAddress" id="cbAddress" value="" size="50">
392 | <input type="button" name="clearInput" id="clearInput" value="Clear" onclick="OnClickButtonclearInput">
393 | <input type="button" name="addFav" id="addFav" value="Add To Favourites" onclick="OnClickButtonaddFav">
394 | <b><p>
395 | <input type="text" name="information" id="information" value="" size="180"></textarea>
396 | <b><p>
397 | <span>Favorites List</span>
398 | <b><p>
399 | <input type="button" name="remFav" id="remFav" value="Remove From Favourites" onclick="OnClickButtonremFav">
400 | <b><p>
401 | <span id="spanList"></span>
402 | &nbsp;&nbsp;<input type="button" name="getFavModel" id="getFavModel" value="Get Selected Stream" onclick="OnClickButtongetFavModel">
403 | <input type="button" name="prevStream" id="prevStream" value="Preview Stream" onclick="OnClickButtonprevStream">
404 | <input type="button" name="vidPreviewClose" id="vidPreviewClose" value="Clear Preview" onclick="OnClickButtonvidPreviewClose">
405 | <b><p>
406 | <span id="vidPreview"></span>
407 | </span>
408 | <!--{{InsertControlsHere}}-Do not remove this line-->
409 | </body>
410 | </html>
411 | 


--------------------------------------------------------------------------------
/Source Code/Form1.frm:
--------------------------------------------------------------------------------
  1 | VERSION 5.00
  2 | Object = "{6BF52A50-394A-11D3-B153-00C04F79FAA6}#1.0#0"; "wmp.dll"
  3 | Begin VB.Form Recorder 
  4 |    BackColor       =   &H00C0C0FF&
  5 |    Caption         =   "Chaturbate Recorder Interface by: 2MinhetNguyles"
  6 |    ClientHeight    =   14970
  7 |    ClientLeft      =   120
  8 |    ClientTop       =   465
  9 |    ClientWidth     =   11085
 10 |    LinkTopic       =   "Form1"
 11 |    ScaleHeight     =   14970
 12 |    ScaleWidth      =   11085
 13 |    StartUpPosition =   3  'Windows Default
 14 |    Begin VB.CommandButton btnGallery 
 15 |       BackColor       =   &H00FFC0FF&
 16 |       Caption         =   "View Gallery"
 17 |       Height          =   495
 18 |       Left            =   8040
 19 |       Style           =   1  'Graphical
 20 |       TabIndex        =   22
 21 |       Top             =   240
 22 |       Width           =   2055
 23 |    End
 24 |    Begin VB.CommandButton btnRunRec 
 25 |       BackColor       =   &H00FFFF80&
 26 |       Caption         =   "View Running Recorders"
 27 |       Height          =   495
 28 |       Left            =   5760
 29 |       Style           =   1  'Graphical
 30 |       TabIndex        =   20
 31 |       Top             =   240
 32 |       Width           =   2055
 33 |    End
 34 |    Begin VB.CheckBox CheckAutoLoad 
 35 |       BackColor       =   &H00C0C0FF&
 36 |       Caption         =   "Auto Load?"
 37 |       Height          =   375
 38 |       Left            =   120
 39 |       TabIndex        =   19
 40 |       Top             =   6840
 41 |       Width           =   2415
 42 |    End
 43 |    Begin VB.CommandButton btnWhoIsOnline 
 44 |       Caption         =   "Check Who Is Online"
 45 |       Height          =   375
 46 |       Left            =   5880
 47 |       TabIndex        =   17
 48 |       Top             =   3000
 49 |       Width           =   3015
 50 |    End
 51 |    Begin VB.CommandButton btnClearPreview 
 52 |       Caption         =   "Clear Preview"
 53 |       Height          =   495
 54 |       Left            =   2880
 55 |       TabIndex        =   16
 56 |       Top             =   7680
 57 |       Width           =   2415
 58 |    End
 59 |    Begin VB.CommandButton btnShowPreview 
 60 |       Caption         =   "Show Preview"
 61 |       Height          =   495
 62 |       Left            =   120
 63 |       TabIndex        =   14
 64 |       Top             =   7680
 65 |       Width           =   2415
 66 |    End
 67 |    Begin VB.ListBox List2 
 68 |       Height          =   3180
 69 |       Left            =   5880
 70 |       TabIndex        =   11
 71 |       Top             =   3480
 72 |       Width           =   3015
 73 |    End
 74 |    Begin VB.CommandButton btnAddFav 
 75 |       Caption         =   "Add To Favourites"
 76 |       Height          =   375
 77 |       Left            =   7320
 78 |       TabIndex        =   10
 79 |       Top             =   1440
 80 |       Width           =   2775
 81 |    End
 82 |    Begin VB.CommandButton btnCopy 
 83 |       Caption         =   "Copy"
 84 |       Height          =   375
 85 |       Left            =   6120
 86 |       TabIndex        =   9
 87 |       Top             =   1440
 88 |       Width           =   1095
 89 |    End
 90 |    Begin VB.CommandButton btnClear 
 91 |       Caption         =   "Clear"
 92 |       Height          =   375
 93 |       Left            =   4920
 94 |       TabIndex        =   8
 95 |       Top             =   1440
 96 |       Width           =   1095
 97 |    End
 98 |    Begin VB.ListBox List1 
 99 |       Height          =   3180
100 |       Left            =   120
101 |       TabIndex        =   7
102 |       Top             =   3480
103 |       Width           =   3015
104 |    End
105 |    Begin VB.CommandButton btnRemFav 
106 |       Caption         =   "Remove From Favourites"
107 |       Height          =   375
108 |       Left            =   120
109 |       TabIndex        =   6
110 |       Top             =   3000
111 |       Width           =   3015
112 |    End
113 |    Begin VB.TextBox information 
114 |       Height          =   375
115 |       Left            =   120
116 |       TabIndex        =   4
117 |       Top             =   1920
118 |       Width           =   9975
119 |    End
120 |    Begin VB.TextBox cbAddress 
121 |       Height          =   375
122 |       Left            =   120
123 |       TabIndex        =   3
124 |       Top             =   1440
125 |       Width           =   4695
126 |    End
127 |    Begin VB.CommandButton btnFFmpeg 
128 |       Caption         =   "Start FFmpeg"
129 |       Height          =   495
130 |       Left            =   2520
131 |       TabIndex        =   1
132 |       Top             =   240
133 |       Width           =   2295
134 |    End
135 |    Begin VB.CommandButton btnGetStreamAddress 
136 |       Caption         =   "Get Stream Address"
137 |       Height          =   495
138 |       Left            =   120
139 |       TabIndex        =   0
140 |       Top             =   240
141 |       Width           =   2295
142 |    End
143 |    Begin VB.Label Label5 
144 |       BackColor       =   &H00C0C0FF&
145 |       Caption         =   "Click on list item to load."
146 |       Height          =   495
147 |       Left            =   3600
148 |       TabIndex        =   21
149 |       Top             =   3840
150 |       Width           =   1815
151 |    End
152 |    Begin VB.Label lblCheck 
153 |       BackColor       =   &H00C0C0FF&
154 |       Height          =   1695
155 |       Left            =   9000
156 |       TabIndex        =   18
157 |       Top             =   3600
158 |       Width           =   1935
159 |    End
160 |    Begin WMPLibCtl.WindowsMediaPlayer WindowsMediaPlayer1 
161 |       Height          =   6615
162 |       Left            =   120
163 |       TabIndex        =   15
164 |       Top             =   8280
165 |       Width           =   10695
166 |       URL             =   ""
167 |       rate            =   1
168 |       balance         =   0
169 |       currentPosition =   0
170 |       defaultFrame    =   ""
171 |       playCount       =   1
172 |       autoStart       =   -1  'True
173 |       currentMarker   =   0
174 |       invokeURLs      =   -1  'True
175 |       baseURL         =   ""
176 |       volume          =   50
177 |       mute            =   0   'False
178 |       uiMode          =   "full"
179 |       stretchToFit    =   0   'False
180 |       windowlessVideo =   0   'False
181 |       enabled         =   -1  'True
182 |       enableContextMenu=   -1  'True
183 |       fullScreen      =   0   'False
184 |       SAMIStyle       =   ""
185 |       SAMILang        =   ""
186 |       SAMIFilename    =   ""
187 |       captioningID    =   ""
188 |       enableErrorDialogs=   0   'False
189 |       _cx             =   18865
190 |       _cy             =   11668
191 |    End
192 |    Begin VB.Label Label4 
193 |       BackColor       =   &H00C0C0FF&
194 |       Caption         =   "Preview Window"
195 |       BeginProperty Font 
196 |          Name            =   "MS Sans Serif"
197 |          Size            =   12
198 |          Charset         =   0
199 |          Weight          =   700
200 |          Underline       =   0   'False
201 |          Italic          =   0   'False
202 |          Strikethrough   =   0   'False
203 |       EndProperty
204 |       Height          =   255
205 |       Left            =   120
206 |       TabIndex        =   13
207 |       Top             =   7320
208 |       Width           =   2655
209 |    End
210 |    Begin VB.Label Label3 
211 |       BackColor       =   &H00C0C0FF&
212 |       Caption         =   "Online Favourites"
213 |       BeginProperty Font 
214 |          Name            =   "MS Sans Serif"
215 |          Size            =   12
216 |          Charset         =   0
217 |          Weight          =   700
218 |          Underline       =   0   'False
219 |          Italic          =   0   'False
220 |          Strikethrough   =   0   'False
221 |       EndProperty
222 |       Height          =   375
223 |       Left            =   5880
224 |       TabIndex        =   12
225 |       Top             =   2520
226 |       Width           =   2175
227 |    End
228 |    Begin VB.Label Label2 
229 |       BackColor       =   &H00C0C0FF&
230 |       Caption         =   "Favourites List:"
231 |       BeginProperty Font 
232 |          Name            =   "MS Sans Serif"
233 |          Size            =   12
234 |          Charset         =   0
235 |          Weight          =   700
236 |          Underline       =   0   'False
237 |          Italic          =   0   'False
238 |          Strikethrough   =   0   'False
239 |       EndProperty
240 |       Height          =   375
241 |       Left            =   120
242 |       TabIndex        =   5
243 |       Top             =   2520
244 |       Width           =   2175
245 |    End
246 |    Begin VB.Label Label1 
247 |       BackColor       =   &H00C0C0FF&
248 |       Caption         =   "Please Enter The Model URL Below:"
249 |       BeginProperty Font 
250 |          Name            =   "MS Sans Serif"
251 |          Size            =   12
252 |          Charset         =   0
253 |          Weight          =   700
254 |          Underline       =   0   'False
255 |          Italic          =   0   'False
256 |          Strikethrough   =   0   'False
257 |       EndProperty
258 |       ForeColor       =   &H00000000&
259 |       Height          =   375
260 |       Left            =   120
261 |       TabIndex        =   2
262 |       Top             =   960
263 |       Width           =   4695
264 |    End
265 | End
266 | Attribute VB_Name = "Recorder"
267 | Attribute VB_GlobalNameSpace = False
268 | Attribute VB_Creatable = False
269 | Attribute VB_PredeclaredId = True
270 | Attribute VB_Exposed = False
271 | Private Sub btnAddFav_Click()
272 | Dim arrTemp
273 | Dim boolMatch
274 | Dim i
275 |     
276 |     If Len(cbAddress.Text) > 22 Then
277 |         arrTemp = Split(cbAddress.Text, "/")
278 |         For i = 0 To List1.ListCount - 1    'Check for duplicates before adding.
279 |             If UCase(List1.List(i)) = UCase(arrTemp(3)) Then boolMatch = True
280 |         Next i
281 |         If Not boolMatch Then List1.AddItem arrTemp(3)
282 |         Call WriteFavourites
283 |     End If
284 | End Sub
285 | 
286 | Private Sub btnClear_Click()
287 |     cbAddress.Text = ""
288 |     information.Text = ""
289 | End Sub
290 | 
291 | Private Sub btnClearPreview_Click()
292 |     WindowsMediaPlayer1.URL = ""
293 | End Sub
294 | 
295 | Private Sub btnCopy_Click()
296 |     Clipboard.Clear
297 |     Clipboard.SetText (cbAddress.Text)
298 | End Sub
299 | 
300 | Private Sub btnFFmpeg_Click()
301 | Dim objShell: Set objShell = CreateObject("WScript.Shell")
302 |     If Len(information.Text) < 20 Then
303 |         MsgBox "You need to get a stream address first!"
304 |     Else
305 |         Debug.Print objShell.CurrentDirectory
306 |         objShell.Run Chr(34) & App.Path & "\ffmpeg.exe" & Chr(34) & " -hwaccel auto -i " & information.Text & " -c:v copy " & Chr(34) & App.Path & "\Recordings\" & getOutputName & Chr(34)
307 |         Sleep (2000)
308 |         Call HideAllRecorders 'hide the ffmpeg window.
309 |     End If
310 | End Sub
311 | 
312 | Private Sub btnGallery_Click()
313 |     Gallery.Show
314 |     Gallery.Top = Me.Top
315 |     Gallery.Left = Me.Left
316 | End Sub
317 | 
318 | Private Sub btnGetStreamAddress_Click()
319 | On Error GoTo ErrorExit
320 | Dim modelHtml
321 |     
322 |     modelHtml = getHTML(cbAddress.Text)
323 |     
324 |     'Format Address
325 |     modelHtml = Left(modelHtml, InStr(modelHtml, ".m3u8") + 4)
326 |     modelHtml = Right(modelHtml, Len(modelHtml) - InStr(modelHtml, "https://edge") + 1)
327 |     
328 |     If Len(modelHtml) < 20 Then
329 |         modelHtml = ""
330 |         MsgBox "Sorry, the model is offline or does not exist!"
331 |     End If
332 |     
333 |     Call unfuckModelAddress(modelHtml)
334 |     
335 |     information.Text = modelHtml
336 |     
337 | ErrorExit:
338 |     Exit Sub
339 |     
340 | End Sub
341 | 
342 | 
343 | Private Sub unfuckModelAddress(ByRef modelURL)
344 | 'Dim strTempA: strTempA = ""
345 | Dim strTempB: strTempB = ""
346 |     
347 |     'strTempA = Left(modelURL, InStr(1, modelURL, "/live")) & "live-hls/"
348 |     'strTempB = Replace(modelURL, strTempA, "")
349 |     
350 |     strTempB = Replace(modelURL, "/live\u002Dhls/", "/live-hls/")
351 |     strTempB = Replace(strTempB, "\u002Dhls/", "")
352 |     strTempB = Replace(strTempB, "\u002D", "-")
353 |     'strTempB = Replace(strTempB, "playlist.m3u8", "chunklist_w693825947_b5128000_t64RlBTOjMwLjA=.m3u8")
354 |     
355 |     modelURL = strTempB 'strTempA & strTempB
356 | 
357 | End Sub
358 | 
359 | 
360 | 
361 | 
362 | Private Sub btnRemFav_Click()
363 | On Error Resume Next
364 |     List1.RemoveItem (List1.ListIndex)
365 |     Call WriteFavourites
366 | End Sub
367 | 
368 | Private Sub btnRunRec_Click()
369 |     RunningRecorders.Show
370 |     RunningRecorders.Left = Me.Left
371 |     RunningRecorders.Top = Me.Top
372 | End Sub
373 | 
374 | 'Show preview of current stream.
375 | Private Sub btnShowPreview_Click()
376 |     WindowsMediaPlayer1.URL = information.Text
377 |     WindowsMediaPlayer1.settings.mute = True
378 |     WindowsMediaPlayer1.stretchToFit = True
379 | End Sub
380 | 
381 | Private Sub btnWhoIsOnline_Click()
382 | On Error Resume Next
383 |     Call whoIsOnline
384 | End Sub
385 | 
386 | Private Sub Command1_Click()
387 |     Clipboard.Clear
388 |     Clipboard.SetText getHTML("https://cbjpeg.stream.highwebmedia.com/stream?room=cutiebooty_em")
389 | End Sub
390 | 
391 | Private Sub Command2_Click()
392 |     Clipboard.Clear
393 |     Clipboard.SetText getHTML("https://cbjpeg.stream.highwebmedia.com/stream?room=happyhornycorn")
394 | End Sub
395 | 
396 | Private Sub Form_Load()
397 | Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
398 | Dim colFavs
399 | Dim x
400 |     
401 |     'Check for ffmpeg.
402 |     If FileExists(App.Path & "\ffmpeg.exe") = False Then MsgBox "ffmpeg not detected, please place it in the same directory as this executable!", vbOKOnly, "ffmpeg missing": Unload Me: Exit Sub
403 |     
404 |     'Load favourites.
405 |     If FileExists(App.Path & "\Favourites.txt") Then
406 |         Set colFavs = ReadFavourites
407 |         For Each x In colFavs
408 |             List1.AddItem x
409 |         Next
410 |     End If
411 |     
412 |     'Check if the recording folder is present, and create it if needed.
413 |     If Not objFSO.FolderExists(App.Path & "\Recordings") Then
414 |         objFSO.CreateFolder (App.Path & "\Recordings")
415 |     End If
416 |     
417 | End Sub
418 | 
419 | 
420 | Private Sub List1_Click()
421 |     Call btnClear_Click
422 |     cbAddress.Text = "https://chaturbate.com/" & List1.Text & "/"
423 |     If CheckAutoLoad.Value = 1 Then
424 |         Call btnGetStreamAddress_Click
425 |         Call btnShowPreview_Click
426 |     End If
427 | End Sub
428 | 
429 | 
430 | 
431 | Private Sub List2_Click()
432 |     Call btnClear_Click
433 |     cbAddress.Text = "https://chaturbate.com/" & List2.Text & "/"
434 |     Call btnGetStreamAddress_Click
435 |     Call btnShowPreview_Click
436 | End Sub
437 | 


--------------------------------------------------------------------------------
/Source Code/Gallery.frm:
--------------------------------------------------------------------------------
  1 | VERSION 5.00
  2 | Object = "{6BF52A50-394A-11D3-B153-00C04F79FAA6}#1.0#0"; "wmp.dll"
  3 | Begin VB.Form Gallery 
  4 |    Caption         =   "Gallery"
  5 |    ClientHeight    =   6990
  6 |    ClientLeft      =   120
  7 |    ClientTop       =   465
  8 |    ClientWidth     =   14820
  9 |    LinkTopic       =   "Form1"
 10 |    ScaleHeight     =   6990
 11 |    ScaleWidth      =   14820
 12 |    StartUpPosition =   3  'Windows Default
 13 |    Begin VB.CheckBox Check1 
 14 |       Caption         =   "Auto Preview"
 15 |       Height          =   255
 16 |       Left            =   2880
 17 |       TabIndex        =   4
 18 |       Top             =   6720
 19 |       Value           =   1  'Checked
 20 |       Width           =   3495
 21 |    End
 22 |    Begin VB.ListBox List2 
 23 |       Height          =   6105
 24 |       Left            =   2880
 25 |       TabIndex        =   2
 26 |       Top             =   480
 27 |       Width           =   3615
 28 |    End
 29 |    Begin VB.ListBox List1 
 30 |       Height          =   6105
 31 |       Left            =   120
 32 |       TabIndex        =   1
 33 |       Top             =   480
 34 |       Width           =   2535
 35 |    End
 36 |    Begin WMPLibCtl.WindowsMediaPlayer WindowsMediaPlayer1 
 37 |       Height          =   6495
 38 |       Left            =   6600
 39 |       TabIndex        =   5
 40 |       Top             =   480
 41 |       Width           =   8055
 42 |       URL             =   ""
 43 |       rate            =   1
 44 |       balance         =   0
 45 |       currentPosition =   0
 46 |       defaultFrame    =   ""
 47 |       playCount       =   1
 48 |       autoStart       =   -1  'True
 49 |       currentMarker   =   0
 50 |       invokeURLs      =   -1  'True
 51 |       baseURL         =   ""
 52 |       volume          =   50
 53 |       mute            =   0   'False
 54 |       uiMode          =   "full"
 55 |       stretchToFit    =   0   'False
 56 |       windowlessVideo =   0   'False
 57 |       enabled         =   -1  'True
 58 |       enableContextMenu=   -1  'True
 59 |       fullScreen      =   0   'False
 60 |       SAMIStyle       =   ""
 61 |       SAMILang        =   ""
 62 |       SAMIFilename    =   ""
 63 |       captioningID    =   ""
 64 |       enableErrorDialogs=   0   'False
 65 |       _cx             =   14208
 66 |       _cy             =   11456
 67 |    End
 68 |    Begin VB.Label Label2 
 69 |       Caption         =   "Video Files:"
 70 |       Height          =   255
 71 |       Left            =   2880
 72 |       TabIndex        =   3
 73 |       Top             =   120
 74 |       Width           =   1695
 75 |    End
 76 |    Begin VB.Label Label1 
 77 |       Caption         =   "Model Name"
 78 |       Height          =   255
 79 |       Left            =   120
 80 |       TabIndex        =   0
 81 |       Top             =   120
 82 |       Width           =   1695
 83 |    End
 84 | End
 85 | Attribute VB_Name = "Gallery"
 86 | Attribute VB_GlobalNameSpace = False
 87 | Attribute VB_Creatable = False
 88 | Attribute VB_PredeclaredId = True
 89 | Attribute VB_Exposed = False
 90 | Private Sub Form_Load()
 91 | Dim colFiles As New Collection
 92 | Dim arrTemp
 93 | Dim boolMatch
 94 | Dim i
 95 | Dim x
 96 |     
 97 |     Set colFiles = FindFiles(App.Path & "\Recordings\", , False, False)
 98 |     
 99 |     For Each x In colFiles
100 |         arrTemp = Split(x, " ")
101 |         boolMatch = False
102 |         For i = 0 To List1.ListCount - 1
103 |             If UCase(arrTemp(0)) = UCase(List1.List(i)) Then boolMatch = True: Exit For
104 |         Next i
105 |         If boolMatch = False Then List1.AddItem arrTemp(0)
106 |     Next
107 |     
108 | End Sub
109 | 
110 | Private Sub List1_Click()
111 | Dim colFiles As New Collection
112 | Dim arrTemp
113 | Dim i
114 | Dim x
115 |     
116 |     Set colFiles = FindFiles(App.Path & "\Recordings\", , False, False)
117 |     List2.Clear
118 |     
119 |     For Each x In colFiles
120 |         arrTemp = Split(x, " ")
121 |         If UCase(arrTemp(0)) = UCase(List1.Text) Then List2.AddItem x
122 |     Next
123 | 
124 | End Sub
125 | 
126 | Private Sub List2_Click()
127 |     If Check1.Value = 1 Then
128 |         WindowsMediaPlayer1.URL = App.Path & "\Recordings\" & List2.Text
129 |         WindowsMediaPlayer1.settings.mute = True
130 |         WindowsMediaPlayer1.stretchToFit = True
131 |     End If
132 | End Sub
133 | 


--------------------------------------------------------------------------------
/Source Code/Module1.bas:
--------------------------------------------------------------------------------
  1 | Attribute VB_Name = "Module1"
  2 | 'Returns the HTML source of a webpage.
  3 | Public Function getHTML(address)
  4 | Dim objXmlHttp: Set objXmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
  5 |     
  6 |     objXmlHttp.Open "get", address
  7 |     objXmlHttp.send
  8 |     getHTML = objXmlHttp.responseText
  9 | 
 10 | End Function
 11 | 
 12 | Public Function AreYouOnline(strModel As String)
 13 | On Error Resume Next
 14 | Dim objXmlHttp: Set objXmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
 15 | Dim tempVar As String
 16 |     
 17 |     objXmlHttp.Open "get", "https://cbjpeg.stream.highwebmedia.com/stream?room=" & strModel
 18 |     objXmlHttp.send
 19 |     tempVar = objXmlHttp.responseText
 20 |     
 21 |     'Err.Number: -1072896748 means online.
 22 |     'Err.Number: -2147467260 means offline.
 23 |     If Err.Number = -1072896748 Then
 24 |         AreYouOnline = True
 25 |     Else
 26 |         AreYouOnline = False
 27 |     End If
 28 | 
 29 | End Function
 30 | 
 31 | 
 32 | 'Determines if a file exists or not.
 33 | Function FileExists(strPath)
 34 | On Error Resume Next
 35 | Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
 36 | Dim boolFile: boolFile = False
 37 |     If objFSO.FileExists(strPath) Then boolFile = True
 38 |     FileExists = boolFile
 39 | End Function
 40 | 
 41 | 
 42 | 'Reads the favourites file.
 43 | Function ReadFavourites()
 44 | 
 45 |     Dim strFile: strFile = App.Path & "\Favourites.txt"
 46 |     Dim textline As String
 47 |     Dim tempCol As New Collection
 48 |     
 49 |     Open strFile For Input As #1
 50 |     
 51 |     Do Until EOF(1)
 52 |         Line Input #1, textline
 53 |         tempCol.Add textline
 54 |     Loop
 55 |     Close #1
 56 |     
 57 |     Set ReadFavourites = tempCol
 58 | 
 59 | End Function
 60 | 
 61 | 
 62 | Sub WriteFavourites()
 63 | Dim strFile: strFile = App.Path & "\Favourites.txt"
 64 | Dim i
 65 |     
 66 |     Open strFile For Output As #1
 67 |     
 68 |     For i = 0 To Recorder.List1.ListCount - 1
 69 |     
 70 |         Print #1, Recorder.List1.List(i)
 71 |     
 72 |     Next i
 73 | 
 74 |     Close #1
 75 | 
 76 | End Sub
 77 | 
 78 | 
 79 | 
 80 | Public Function FindFiles(FolderPath As String, _
 81 |                           Optional FileExtension As String, _
 82 |                           Optional IncludeDirectories As Boolean, _
 83 |                           Optional onlyDirectories As Boolean) As Collection
 84 | Dim file As String
 85 | Dim i As Integer
 86 | Dim tempArray As New Collection
 87 | Dim objFSO
 88 | Dim x As String
 89 |     
 90 |     Set objFSO = CreateObject("Scripting.FileSystemObject")
 91 | 
 92 |     If IncludeDirectories = True Then
 93 |         file = Dir(FolderPath, vbDirectory)
 94 |     Else
 95 |         file = Dir(FolderPath)
 96 |     End If
 97 |     
 98 |     i = 0
 99 |     While file <> ""
100 |         If onlyDirectories Then
101 |             x = FolderPath & file
102 |             If (objFSO.FolderExists(x)) And file <> "." And file <> ".." And file <> "" Then
103 |                 tempArray.Add file
104 |                 i = i + 1
105 |             End If
106 |         Else
107 |             If InStr(1, file, FileExtension) > 1 Or FileExtension = vbNullString And file <> "." And file <> ".." Then
108 |                 tempArray.Add file
109 |                 i = i + 1
110 |             End If
111 |         End If
112 |         
113 |         file = Dir
114 |     Wend
115 |     
116 |     Set FindFiles = tempArray
117 | 
118 | End Function
119 | 
120 | 'Populates the online list.
121 | Sub whoIsOnline()
122 | Dim modelHtml
123 | Dim i
124 |     
125 |     Recorder.List2.Clear
126 |     For i = 1 To Recorder.List1.ListCount
127 |     
128 |         Recorder.lblCheck.Caption = "Checking: " & i & " of " & Recorder.List1.ListCount
129 | '        DoEvents
130 | '        modelHtml = getHTML("https://chaturbate.com/" & Recorder.List1.List(i - 1) & "/")
131 |         
132 |         'Format Address
133 | '        modelHtml = Left(modelHtml, InStr(modelHtml, ".m3u8") + 4)
134 | '        modelHtml = Right(modelHtml, Len(modelHtml) - InStr(modelHtml, "https://edge") + 1)
135 |         
136 | '        If Len(modelHtml) < 20 Then
137 | '            modelHtml = ""
138 |             'Offline
139 | '        Else
140 | '            Recorder.List2.AddItem Recorder.List1.List(i - 1)
141 | '        End If
142 | 
143 |         If AreYouOnline(Recorder.List1.List(i - 1)) Then Recorder.List2.AddItem Recorder.List1.List(i - 1)
144 |         DoEvents
145 |         
146 |     Next i
147 | 
148 |     Recorder.lblCheck.Caption = ""
149 | 
150 | End Sub
151 | 
152 | 
153 | 
154 | 
155 | 'Figures out the output name of the stream to be recorded
156 | Function getOutputName()
157 | Dim objShell: Set objShell = CreateObject("WScript.Shell")
158 | Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
159 | Dim outputName
160 | Dim i
161 |     
162 |     outputName = Right(Recorder.cbAddress.Text, Len(Recorder.cbAddress.Text) - 23)
163 |     outputName = Replace(outputName, "/", "")
164 |     outputName = outputName & " " & Replace(Now(), "/", "-")
165 |     outputName = Replace(outputName, ":", ".")
166 |     outputName = outputName & ".mp4"
167 |     
168 |     getOutputName = outputName
169 |     
170 | End Function
171 | 
172 | 
173 | 
174 | 'Hides all ffmpeg windows.
175 | Sub HideAllRecorders()
176 | Dim colRecorders As New Collection
177 | Dim x
178 |     
179 |     Set colRecorders = LoadTaskList
180 |     
181 |     For Each x In colRecorders
182 |         Call HideWindow(CDbl(x))
183 |     Next
184 | End Sub
185 | 
186 | 


--------------------------------------------------------------------------------
/Source Code/Module2.bas:
--------------------------------------------------------------------------------
 1 | Attribute VB_Name = "Module2"
 2 | Const SWP_HIDEWINDOW = &H80
 3 |     Const SWP_SHOWWINDOW = &H40
 4 |     Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
 5 |         (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 6 | 
 7 |     Private Declare Function SetWindowPos Lib "user32" _
 8 |         (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
 9 |         ByVal x As Long, ByVal y As Long, _
10 |         ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
11 |         Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
12 | Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
13 | Private Const GWL_STYLE = (-16)
14 | Private Const WS_CAPTION = &HC00000                  '  WS_BORDER Or WS_DLGFRAME
15 | 
16 | 
17 | Option Explicit
18 | Private Const PROCESS_ALL_ACCESS = &H1F0FFF
19 | 
20 | Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
21 |     ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
22 | Private Declare Function GetExitCodeProcess Lib "kernel32" _
23 |     (ByVal hProcess As Long, lpExitCode As Long) As Long
24 | Private Declare Function TerminateProcess Lib "kernel32" _
25 |     (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
26 | 
27 | Sub HideWindow(gtWnd As Long)
28 |         'Dim gtWnd As Long
29 |         'gtWnd = FindWindow(vbNullString, strWindowName)
30 |         SetWindowPos gtWnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW
31 | End Sub
32 | 
33 | 
34 | Sub UnHideWindow(gtWnd As Long)
35 |         'Dim gtWnd As Long
36 |         'gtWnd = FindWindow(vbNullString, strWindowName)
37 |         SetWindowPos gtWnd, 0, 0, 0, 500, 500, SWP_SHOWWINDOW
38 | End Sub
39 | 


--------------------------------------------------------------------------------
/Source Code/Module3.bas:
--------------------------------------------------------------------------------
 1 | Attribute VB_Name = "Module3"
 2 | Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
 3 | Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
 4 | Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
 5 | Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
 6 | Const GW_HWNDFIRST = 0
 7 | Const GW_HWNDNEXT = 2
 8 | 
 9 | Function LoadTaskList()
10 | Dim CurrWnd As Long
11 | Dim Length As Long
12 | Dim TaskName As String
13 | Dim Parent As Long
14 | Dim tempCol As New Collection
15 | 
16 |     CurrWnd = GetWindow(Recorder.hwnd, GW_HWNDFIRST)
17 |     While CurrWnd <> 0
18 |         Parent = GetParent(CurrWnd)
19 |         Length = GetWindowTextLength(CurrWnd)
20 |         TaskName = Space$(Length + 1)
21 |         Length = GetWindowText(CurrWnd, TaskName, Length + 1)
22 |         TaskName = Left$(TaskName, Len(TaskName) - 1)
23 |         
24 |         If Length > 0 Then
25 |             If TaskName <> Recorder.Caption Then
26 |                 If UCase(Right(TaskName, 10)) = "FFMPEG.EXE" Then tempCol.Add CurrWnd
27 |             End If
28 |         End If
29 |         CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
30 |     Wend
31 |     
32 |     Set LoadTaskList = tempCol
33 |     
34 | End Function
35 | 


--------------------------------------------------------------------------------
/Source Code/Module4.bas:
--------------------------------------------------------------------------------
1 | Attribute VB_Name = "Module4"
2 | 'Call Sleep(Milliseconds)
3 | Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
4 | 


--------------------------------------------------------------------------------
/Source Code/Project1.vbp:
--------------------------------------------------------------------------------
 1 | Type=Exe
 2 | Form=Form1.frm
 3 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\stdole2.tlb#OLE Automation
 4 | Object={EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0; ieframe.dll
 5 | Module=Module1; Module1.bas
 6 | Object={6BF52A50-394A-11D3-B153-00C04F79FAA6}#1.0#0; wmp.dll
 7 | Module=Module2; Module2.bas
 8 | Module=Module3; Module3.bas
 9 | Form=RunningRecorders.frm
10 | Module=Module4; Module4.bas
11 | Form=Gallery.frm
12 | Module=modTypes; modTypes.bas
13 | Module=modEnums; modEnums.bas
14 | Module=modCollections; modCollections.bas
15 | IconForm="Recorder"
16 | Startup="Recorder"
17 | HelpFile=""
18 | Title="Recorder"
19 | ExeName32="Chaturbate Recorder.exe"
20 | Path32=".."
21 | Command32=""
22 | Name="ChaturbateRecorder"
23 | HelpContextID="0"
24 | CompatibleMode="0"
25 | MajorVer=1
26 | MinorVer=0
27 | RevisionVer=2
28 | AutoIncrementVer=0
29 | ServerSupportFiles=0
30 | VersionComments="VB6.0 Recorder By: 2MinhetNguyles"
31 | CompilationType=0
32 | OptimizationType=0
33 | FavorPentiumPro(tm)=0
34 | CodeViewDebugInfo=0
35 | NoAliasing=0
36 | BoundsCheck=-1
37 | OverflowCheck=-1
38 | FlPointCheck=-1
39 | FDIVCheck=-1
40 | UnroundedFP=-1
41 | StartMode=0
42 | Unattended=0
43 | Retained=0
44 | ThreadPerObject=0
45 | MaxNumberOfThreads=1
46 | DebugStartupOption=0
47 | 
48 | [Rubberduck]
49 | ProjectId=e1cbc412-babd-4253-9107-401d1f6dd04c
50 | 


--------------------------------------------------------------------------------
/Source Code/Project1.vbw:
--------------------------------------------------------------------------------
 1 | Recorder = 104, 104, 1509, 785, C, 26, 26, 1405, 707, C
 2 | Module1 = 182, 182, 1587, 863, C
 3 | Module2 = 286, 286, 1891, 967, C
 4 | Module3 = 312, 312, 1917, 993, C
 5 | RunningRecorders = 130, 130, 1735, 811, C, 78, 78, 1683, 759, C
 6 | Module4 = 26, 26, 1631, 707, C
 7 | Gallery = 260, 260, 1865, 941, C, 104, 104, 1709, 785, C
 8 | modTypes = 208, 208, 1813, 878, 
 9 | modEnums = 234, 234, 1839, 904, C
10 | modCollections = 312, 312, 1917, 982, Z
11 | 


--------------------------------------------------------------------------------
/Source Code/RunningRecorders.frm:
--------------------------------------------------------------------------------
 1 | VERSION 5.00
 2 | Begin VB.Form RunningRecorders 
 3 |    Caption         =   "Running Recorders"
 4 |    ClientHeight    =   5100
 5 |    ClientLeft      =   120
 6 |    ClientTop       =   465
 7 |    ClientWidth     =   6705
 8 |    LinkTopic       =   "Form1"
 9 |    ScaleHeight     =   5100
10 |    ScaleWidth      =   6705
11 |    StartUpPosition =   3  'Windows Default
12 |    Begin VB.Timer Timer1 
13 |       Interval        =   1000
14 |       Left            =   4320
15 |       Top             =   240
16 |    End
17 |    Begin VB.CommandButton btnHide 
18 |       Caption         =   "Hide All Recorders"
19 |       Height          =   495
20 |       Left            =   4320
21 |       TabIndex        =   3
22 |       Top             =   4320
23 |       Width           =   2175
24 |    End
25 |    Begin VB.CommandButton btnShow 
26 |       Caption         =   "Show All Recorders"
27 |       Height          =   495
28 |       Left            =   4320
29 |       TabIndex        =   2
30 |       Top             =   720
31 |       Width           =   2175
32 |    End
33 |    Begin VB.ListBox List1 
34 |       Height          =   4155
35 |       Left            =   120
36 |       TabIndex        =   1
37 |       Top             =   720
38 |       Width           =   4095
39 |    End
40 |    Begin VB.Label Label2 
41 |       Caption         =   $"RunningRecorders.frx":0000
42 |       Height          =   2295
43 |       Left            =   4320
44 |       TabIndex        =   4
45 |       Top             =   1680
46 |       Width           =   2175
47 |    End
48 |    Begin VB.Label Label1 
49 |       Caption         =   "Window Handle"
50 |       Height          =   375
51 |       Left            =   120
52 |       TabIndex        =   0
53 |       Top             =   240
54 |       Width           =   2175
55 |    End
56 | End
57 | Attribute VB_Name = "RunningRecorders"
58 | Attribute VB_GlobalNameSpace = False
59 | Attribute VB_Creatable = False
60 | Attribute VB_PredeclaredId = True
61 | Attribute VB_Exposed = False
62 | Private Sub btnHide_Click()
63 | Dim i
64 |     If List1.ListCount <> 0 Then
65 |         For i = 0 To List1.ListCount - 1
66 |             Call HideWindow(CDbl(List1.List(i)))
67 |         Next i
68 |     End If
69 | End Sub
70 | 
71 | Private Sub btnShow_Click()
72 | Dim i
73 |     If List1.ListCount <> 0 Then
74 |         For i = 0 To List1.ListCount - 1
75 |             Call UnHideWindow(CDbl(List1.List(i)))
76 |         Next i
77 |     End If
78 | End Sub
79 | 
80 | 'Updates the list of recorders each tick.
81 | Private Sub Timer1_Timer()
82 | Dim colRecorders As New Collection
83 | Dim x
84 |     
85 |     List1.Clear
86 |     Set colRecorders = LoadTaskList
87 |     
88 |     For Each x In colRecorders
89 |         List1.AddItem x
90 |     Next
91 |     
92 | End Sub
93 | 


--------------------------------------------------------------------------------
/Source Code/RunningRecorders.frx:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/2MinhetNguyles/Chaturbate-Recorder-GUI/4f6cde34e4a36ead18d5edc300be9a0407237e5b/Source Code/RunningRecorders.frx


--------------------------------------------------------------------------------
/Source Code/modCollections.bas:
--------------------------------------------------------------------------------
1 | Attribute VB_Name = "modCollections"
2 | Public colActiveRecorders As Collection         'Collection of active recorders.
3 | Public colRecorderbotList As Collection         'Collection of camgirls to be monitored by the recorder bot.
4 | 


--------------------------------------------------------------------------------
/Source Code/modEnums.bas:
--------------------------------------------------------------------------------
1 | Attribute VB_Name = "modEnums"
2 | 'Enumeration for the status of a model's cam.
3 | Public Enum camStatus
4 |     Offline = 0
5 |     Online 1
6 | End Enum
7 | 


--------------------------------------------------------------------------------
/Source Code/modTypes.bas:
--------------------------------------------------------------------------------
 1 | Attribute VB_Name = "modTypes"
 2 | 'Cam girl type.
 3 | Public Type CamGirl
 4 |     name As String          'Name of camgirl
 5 |     status As Integer       'Using enum: camStatus
 6 |     m3u8 As String          'm3u8 address string
 7 |     recording As Boolean    'Whether or not there is a recording running for this cam girl
 8 | End Type
 9 | 
10 | 
11 | 'Used to keep track of what recorder is what.
12 | Public Type ffMpegRecorder
13 |     hWnd As String
14 |     ModelName As String
15 | End Type
16 | 


--------------------------------------------------------------------------------