Imports System.IO Public Class serv_u Public Shared Sub FTPuserEdit(ByVal Accion As String, ByVal RutaIni As String, ByVal Usuario As String, ByVal Passwd As String, ByVal HomeDir As String, ByVal IP As String, ByVal Puerto As String, ByVal Permisos As String, ByVal RutaActualizaciones As String, ByVal ConfiguracionAdicional() As String) Try If RutaActualizaciones = "" Then RutaActualizaciones = "C:\TECNOSIS\BIN\ACTUALIZACIONES" Dim SW As StreamWriter Dim SR As StreamReader Dim separadores() As Char = {"=", "|"} Dim linea, p(), dominio(), PassCrypt As String Dim nomdom As String = "" Dim numdom As String = "" Dim encDom, encUser As Boolean Dim i As Integer 'Comprobamos que se nos proporciona una accion valida If Accion = "" Then Throw New Exception("Acción no especificada: Por favor, indique una " & "de las posibles acciones (ALTA/BAJA).") Exit Sub End If 'Permisos es una cadena entre 0 y 9 letras en el siguiente orden: RWAMELCDP 'Las 5 primeras son los acceso a ficheros: Read(R), Write(W), Append(A), Delete(M), Execute(E) 'Las 3 siguientes son los acceso al directorio: List(L), Create(C), Remove(D) 'La ultima es el acceso a subdirectorios: Inherit(P) If Permisos = "" Then Permisos = "RWAMLCP" End If 'Buscamos el dominio al que pertenece el usuario SR = File.OpenText(RutaIni & "\ServUDaemon.ini") encDom = False Do linea = SR.ReadLine If linea Is Nothing Then Exit Do End If '=||||||0 'dominio(0)=dominio(1)|dominio(2)|dominio(3)|dominio(4)|dominio(5)|dominio(6)|dominio(7) 'En dominio(0) tendremos la etiqueta del dominio, en dominio(1) tendremos la IP, 'en dominio(3) el puerto y en dominio(5) el numero de dominio dominio = linea.Split(separadores) If dominio.Length > 5 Then If Not encDom And dominio(1) = IP And dominio(3) = Puerto Then nomdom = dominio(0) numdom = dominio(5) encDom = True End If End If Loop Until encDom SR.Close() 'Si hemos encontrado el dominio, copiamos el contenido del fichero hasta llegar 'a la etiqueta del dominio buscado (si es que existe) If encDom Then SR = File.OpenText(RutaIni & "\ServUDaemon.ini") SW = File.CreateText(RutaIni & "\ServUDaemon.txt") SW.AutoFlush = True 'Copiamos lineas hasta llegar a la etiqueta del dominio buscado encDom = True Do linea = SR.ReadLine 'Si llegamos al final del fichero y no hemos encontrado la etiqueta 'salimos del bucle e indicamos que no se ha encontrado dicha etiqueta If IsNothing(linea) Then encDom = False Exit Do End If SW.WriteLine(linea) Loop Until linea = "[" & nomdom & "]" Select Case Accion.ToUpper Case "ALTA" 'Comprobamos que el usuario y la password no estan vacios If Usuario = "" OrElse Passwd = "" Then SR.Close() SW.Close() Throw New Exception("Datos incompletos: El usuario o la clave están " & "vacíos. Por favor, complete ambos campos.") Exit Sub End If 'Si no hemos encontrado la etiqueta del dominio la escribimos, 'ya que eso significa que aun no hay datos sobre el dominio, 'y procedemos a dar de alta al nuevo usuario (que es el primero) If Not encDom Then SW.WriteLine("[" & nomdom & "]") SW.WriteLine("User1=" & Usuario & "|1|0") Else 'Buscamos el numero de usuarios existentes en el dominio i = 1 Do linea = SR.ReadLine If IsNothing(linea) Then 'Si llegamos al final del fichero nos salimos del bucle Exit Do ElseIf linea.Substring(0, 1) = "[" Then 'Si encontramos otra etiqueta nos salimos del bucle Exit Do End If SW.WriteLine(linea) p = linea.Split(separadores) 'Comprobamos que el usuario a dar de alta no exista en el dominio If p(0).Substring(0, 4) = "User" Then If p(1) = Usuario Then 'Si existe abortamos el proceso y nos salimos SR.Close() SW.Close() Throw New Exception("Usuario existente: El usuario ya " & "existe en el dominio actual.") Exit Sub Else 'Si no coincide el nombre incrementamos el contador i += 1 End If End If Loop 'Añadimos el nuevo usuario al final de la lista SW.WriteLine("User" & i & "=" & Usuario & "|1|0") 'Y si la linea leida no es Nothing la copiamos al fichero destino If Not IsNothing(linea) Then SW.WriteLine(linea) End If End If 'Copiamos el resto del fichero linea = SR.ReadToEnd SW.Write(linea) 'Añadimos al final del fichero los datos del nuevo usuario 'PassCrypt = GeneraMD5(Passwd, False) PassCrypt = GeneraMD5(Passwd) SW.WriteLine("[USER=" & Usuario & "|" & numdom & "]") SW.WriteLine("Password=" & PassCrypt) SW.WriteLine("HomeDir=" & HomeDir) SW.WriteLine("NeedSecure=1") SW.WriteLine("RelPaths=1") SW.WriteLine("TimeOut=600") SW.WriteLine("Access1=" & HomeDir & "|" & Permisos.ToUpper) SW.WriteLine("Access2=" & RutaActualizaciones & "|REL") For i = 0 To ConfiguracionAdicional.Length - 1 SW.WriteLine(ConfiguracionAdicional(i)) Next Case "BAJA" 'Comprobamos que el usuario no esta vacio If Usuario = "" Then SR.Close() SW.Close() Throw New Exception("Datos incompletos: El usuario está vacío. " & "Por favor, complete el campo.") Exit Sub End If 'Si no hemos encontrado la etiqueta del dominio es que no habia ningun usuario 'para ese dominio,por tanto, anulamos el proceso de la baja If Not encDom Then SR.Close() SW.Close() Throw New Exception("Usuario no encontrado: El dominio no tiene ningún " & "usuario. El proceso de baja se anulará.") Exit Sub Else 'Buscamos el usuario a dar de baja encUser = False Do linea = SR.ReadLine 'Si llegamos al final del fichero sin encontrar al usuario, 'es que este no existia y asi lo indicamos If IsNothing(linea) Then SR.Close() SW.Close() Throw New Exception("Usuario no encontrado: El usuario especificado " & "no existe en el dominio. El proceso de baja se " & "anulará.") Exit Sub ElseIf linea.Substring(0, 1) = "[" Then 'Si encontramos otra etiqueta es que no hemos encontrado al usuario 'en el dominio, avisamos de ello y salimos de la rutina SR.Close() SW.Close() Throw New Exception("Usuario no encontrado: El usuario especificado " & "no existe en el dominio. El proceso de baja se " & "anulará.") Exit Sub End If p = linea.Split(separadores) If p(0).Substring(0, 4) = "User" Then 'Si es el usuario buscado lo indicamos y no copiamos la linea, 'en otro caso, copiamos la linea leida If p(1) = Usuario Then encUser = True Else SW.WriteLine(linea) End If Else SW.WriteLine(linea) End If Loop Until encUser 'Guardo el numero del usuario que damos de baja i = CInt(p(0).Substring(4)) 'Reenumeramos al resto de usuarios Do linea = SR.ReadLine p = linea.Split("=") If IsNothing(linea) Then 'Si llegamos al final del fichero nos salimos del bucle Exit Do ElseIf linea.Substring(0, 1) = "[" Then 'Si encontramos otra etiqueta nos salimos del bucle Exit Do ElseIf p(0).Substring(0, 4) = "User" Then linea = "User" & i & "=" & p(1) i += 1 End If SW.WriteLine(linea) Loop 'Si la ultima linea leida no es Nothing copiamos dicha linea 'a menos que sea la etiqueta del usuario a dar de baja If IsNothing(linea) Then Exit Select Else 'Escribo todas las lineas del fichero original hasta encontrar la etiqueta 'del usuario a dar de baja Do Until linea = "[USER=" & Usuario & "|" & numdom & "]" SW.WriteLine(linea) linea = SR.ReadLine Loop 'Leo todas las lineas del bloque correspondiente al usuario a dar de baja Do linea = SR.ReadLine If IsNothing(linea) Then 'Si llego al final del fichero salgo del bucle Exit Do End If Loop Until linea.Substring(0, 1) = "[" End If 'Si la ultima linea leida no es Nothing la copiamos al fichero destino If Not IsNothing(linea) Then SW.WriteLine(linea) End If 'Copiamos el resto del fichero linea = SR.ReadToEnd SW.Write(linea) End If Case "MODIFICA" 'De momento sin uso SR.Close() SW.Close() Throw New Exception("Acción no implementada: Por favor, indique una de " & "las posibles acciones (ALTA/BAJA).") Exit Sub Case Else SR.Close() SW.Close() Throw New Exception("Acción no válida: Por favor, indique una de " & "las posibles acciones (ALTA/BAJA).") Exit Sub End Select SR.Close() SW.Close() File.Copy(RutaIni & "\ServUDaemon.ini", RutaIni & "\ServUDaemon.bak", True) File.Copy(RutaIni & "\ServUDaemon.txt", RutaIni & "\ServUDaemon.ini", True) Else 'Si no hemos encontrado el dominio Throw New Exception("Dominio no encontrado: No se ha encontrado el dominio " & "buscado. Verifique los datos de IP y puerto.") End If Catch ex As Exception Throw New Exception("Error: rutina FTPuserEdit" & Chr(10) & Chr(13) & ex.Message) End Try End Sub Public Shared Function GeneraMD5(ByVal SourceText As String, ByVal CtrlErrores As Boolean) As String Try Dim oMD5, sHashedStr As Object Dim salt As String ' create the object oMD5 = CreateObject("MD5.WSC") ' The calcMD5 method will hash the given string using MD5. ' NOTE: The password given by the user in this example would ' be "test". The two characters prepended to the ' password ("yy") are the salt. The salt is created ' by choosing two random characters from a..z. ' sHashedStr contains the hashed string. salt = GeneraSalt(CtrlErrores) sHashedStr = oMD5.calcMD5(salt & SourceText) ' clean up oMD5 = Nothing Return salt & sHashedStr Catch EX As Exception If CtrlErrores Then MsgBox(EX.Message, MsgBoxStyle.Critical, "Error en la rutina GeneraMD5") Else Throw New Exception("Error: rutina GeneraMD5" & Chr(10) & Chr(13) & EX.Message) End If Return "" End Try End Function Public Shared Function GeneraMD5(ByVal strToHash As String) As String Dim md5Obj As New Security.Cryptography.MD5CryptoServiceProvider Dim salt As String = GeneraSalt(False) Dim bytesToHash() As Byte = System.Text.Encoding.ASCII.GetBytes(salt & strToHash) bytesToHash = md5Obj.ComputeHash(bytesToHash) Dim strResult As String = "" For Each b As Byte In bytesToHash strResult += b.ToString("x2") Next Return salt & strResult.ToUpper End Function Public Shared Function getMD5HashANT(ByVal strToHash As String) As String Try Dim oMD5, sHashedStr As Object oMD5 = CreateObject("MD5.WSC") sHashedStr = oMD5.calcMD5(strToHash) oMD5 = Nothing Return sHashedStr Catch EX As Exception Throw New Exception("Error: rutina GeneraMD5" & Chr(10) & Chr(13) & EX.Message) End Try End Function Public Shared Function getMD5Hash(ByVal strToHash As String) As String Dim md5Obj As New Security.Cryptography.MD5CryptoServiceProvider Dim bytesToHash() As Byte = System.Text.Encoding.ASCII.GetBytes(strToHash) bytesToHash = md5Obj.ComputeHash(bytesToHash) Dim strResult As String = "" For Each b As Byte In bytesToHash strResult += b.ToString("x2") Next Return strResult.ToUpper End Function Private Shared Function GeneraSalt(Optional ByVal CtrlErrores As Boolean = False) As String Try Dim p1, p2, li, ls As Integer Dim s1, s2 As String Dim cadena As String = "abcdefghijklmnopqrstuvwxyz" li = 0 ls = cadena.Length - 1 p1 = CInt(Int((ls - li + 1) * Rnd() + li)) p2 = CInt(Int((ls - li + 1) * Rnd() + li)) s1 = cadena.Substring(p1, 1) s2 = cadena.Substring(p2, 1) Return s1 & s2 Catch ex As Exception If CtrlErrores Then MsgBox(ex.Message, MsgBoxStyle.Critical, "Error en la rutina GeneraSalt") Else Throw New Exception("Error: rutina GeneraSalt" & Chr(10) & Chr(13) & ex.Message) End If Return "" End Try End Function End Class