Problema de Criptografia

[Cesar_Loko 0]

Bom galera meu problema é o seguinte...

 

Eu tenho uma String T() que eu li de um arquivo TXT.

 

Preciso normaliza-la, retirando os exessos de espaços no começo, final e entre as palavras...

 

Mas estou com alguma dificuldade em fazer isso...

 

Da mesma forma que estou com alguns outros problemas com as outras funções...

 

Estou iniciando agora minha jornado pelo Mundo do QBasic...

 

Se alguém puder me ajudar...

 

Estou fazendo um programinha para Criptografia, pretendo usar a Cifra de César, pois eh mais fácil de entender...

 

Esse é o Módulo Startup do Programa:

 

'*****************************************************************************'* Objetivo:	Codificação (encryption) e decodificação (decryption) de ar- *'*			  quivo texto normalizado (sem excesso de brancos), através de *'*			  criptografia por substituição simétrica (chave única) e uti- *'*			  lizando os dois processos abaixo.							*'*																		   *'*			  1) Substitui o texto pleno (plaintext) original NORMALIZADO, *'*				 deslocando os caracteres, a partir da Cifra de César, ou  *'*				 seja, aplicando Aritmética Módulo M.					  *'*			  2) Substitui o alfabeto do texto cifrado por outro alfabeto  *'*				 gerado de forma pseudo-randômica.						 *'*																		   *'* Considerações:															*'*																		   *'* A decodificação consiste em aplicar os passos invertidos da codificação.  *'*																		   *'* Este arquivo implementa as abstrações de processos (ações) exclusivas pa- *'* ra entrada/sáida de dados, via caixas de diálogos e arquivos textos.	  *'*																		   *'* As abstrações de ações necessárias para a criptografia, estão implementa- *'* das em arquivo de módulo padrão e podem ser utilizadas (sem nenhuma alte- *'* ração) por outra aplicação.											   *'*																		   *'***************************************************************************** Option Explicit 'requer declarar as variáveis antes de usá-las'declarações de constantes globais  Const MAXTAM = 10	 'tamanho máximo para o nome dos arquivos Const MAXLINE = 10	'quantidade máxima de linhas (strings) no texto Const MAXCHAR = 100   'quantidade máxima de caracteres na linha do texto Const LETRAS = " ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" Const LETRAS_COM_ACENTOS = "ÀÁÂÄÃÈÉÊËÌÍÏÒÓÔÕÖÙÚÛÜÇÑàáâäãèéêëìíïòóôõöùúûüçñÿ" Const ALFANUMERICOS = "!#$%&'()*+,-./:;<=>?@[]\ªº_" 'sem aspas duplas !!! Const NUMERICOS = "0123456789" 'Abstrações de Processos (ações) exclusivas para Entrada e Saída de Dados'*****************************************************************************'* Retorna um inteiro no intervalo pré-definido, fornecido via InputBox.	 *'*****************************************************************************Public Function GetInt(ByRef titulo As String, ByRef msg As String, _				ByVal liminf As Integer, ByVal limsup As Long) As Long'declarações locais neste escopo Dim strin As String 'entrada recebida via caixa de diálogo InputBox'instruções - comandos e chamadas de procedimentos e/ou funções Do 'laço eterno para receber entrada válida	 strin = InputBox(msg & vbCrLf & vbCrLf & "Intervalo Válido : de " & _					  liminf & " até " & limsup, titulo)	 If strin = "" Then		'força entrada de dados, quando pressiona, Esc, Cancel, Enter ou OK		MsgBox "Deve fornecer uma Entrada !", vbCritical, titulo	 Else		'consistência da entrada		If IsNumeric(strin) And _		   Val(strin) >= liminf And Val(strin) <= limsup And _		   Val(strin) = Int(Val(strin)) Then		   GetInt = Val(strin) 'retorna um natural no nome da função		   Exit Do 'finaliza laço eterno (desvio incondicional) !		End If 'finaliza seleção unidirecional		MsgBox "Entrada Incorreta !", vbCritical, titulo	 End If 'finaliza seleção bidirecional Loop While True 'condição do laço eternoEnd Function 'GetInt'*****************************************************************************'* Mostrar mensagem quando desvia para "On Error..." no tratamento de IO.	*'*****************************************************************************Sub MensagemErroIO(msg As String) Select Case Err.Number 'Err.Number é uma variável do sistema!  Case 53	   MsgBox msg & ": Arquivo não encontrado !", vbCritical, "Erro de IO"  Case 70	   MsgBox msg & ": Permissão de acesso negado !", vbCritical, "Erro de IO"  Case 71	   MsgBox msg & ": Não existe disco na unidade ou não corretamente " & vbCrLf & _					"inserido ! ", vbCritical, "Erro de IO"  Case 75	   MsgBox msg & ": Erro de acesso ao caminho ou arquivo !", vbCritical, "Erro de IO"  Case 76	   MsgBox msg & ": Caminho não encontrado !", vbCritical, "Erro de IO"  Case Else	   MsgBox msg & ": Código do erro = " & Err.Number & vbCrLf & _					"Descrição do erro = " & Err.Description, vbCritical, "Erro de IO" End SelectEnd Sub 'MensagemErroIO'*****************************************************************************'* Compara se o conteúdo de dois arquivos em modo texto, são ou não iguais.  *'*****************************************************************************Function ComparaArquivosTexto(nomearq1 As String, nomearq2 As String) As Boolean'declarações locais neste escopo Dim linha1 As String 'linha do arquivo 1 Dim linha2 As String 'linha do arquivo 2'instruções - comandos e chamadas de procedimentos e/ou funções On Error GoTo ERROIO			   'habilita tratamento de erro Open nomearq1 For Input As #1	  'abre o arquivo 1 para leitura Open nomearq2 For Input As #2	  'abre o arquivo 2 para leitura ComparaArquivosTexto = False	   'inicializa retorno como FALSO If LOF(1) <> LOF(2) Then		   'verifica o tamanho dos arquivos	Close #1						'fecha o arquivo 1	Close #2						'fecha o arquivo 2	Exit Function				   'finaliza a função End If							 'fim da condição unidirecional Do Until EOF(1)					'repetir até encontrar End-Of-File	Line Input #1, linha1		   'lê linha do arquivo 1 finalizada por CR+LF	Line Input #2, linha2		   'lê linha do arquivo 2 finalizada por CR+LF	If linha1 <> linha2 Then		'compara as duas linhas	   Close #1					 'fecha o arquivo 1	   Close #2					 'fecha o arquivo 2	   Exit Function				'finaliza a função	End If						  'fim da condição unidirecional Loop							   'fim do laço para leitura ComparaArquivosTexto = True		'arquivos são iguais Close #1						   'fecha o arquivo 1 Close #2						   'fecha o arquivo 2 Exit Function					  'finaliza a funçãoERROIO: 'Interrupção por falha de IO MensagemErroIO ("Comparação") 'chama o procedimento e retorna End 'finaliza o programaEnd Function 'ComparaArquivosTexto'*****************************************************************************'* Gravar o texto T com N strings (linhas) em um arquivo texto.			  *'*****************************************************************************Sub GravarArquivoTexto(nomearq As String, T() As String, n As Integer)'declarações locais neste escopo Dim i As Integer 'indexador para acesso a string do texto'instruções - comandos e chamadas de procedimentos e/ou funções On Error GoTo ERROIO		   'habilita tratamento de erro Open nomearq For Output As #1  'abre o arquivo para gravação For i = 0 To n				 'indexador do texto varia de 0 até N-1	 Print #1, T(i)			 'grava linha finalizada por CR+LF Next i						 'avança para a próxima string no texto Close #1					   'fecha o arquivo Exit Sub					   'finaliza o procedimentoERROIO: 'Interrupção por falha de IO MensagemErroIO ("Gravação") 'chama o procedimento e retorna End 'finaliza o programaEnd Sub 'GravarArquivoTexto'*****************************************************************************'* Ler um arquivo texto armazenando-o em um array T com N strings.		   *'*****************************************************************************Sub LerArquivoTexto(nomearq As String, T() As String, ByRef n As Integer)'instruções - comandos e chamadas de procedimentos e/ou funções On Error GoTo ERROIO			'habilita tratamento de erro Open nomearq For Input As #1	'abre o arquivo para leitura n = 0						   'inicializa contador de linhas do texto Do Until EOF(1)				 'repetir até encontrar EOF (End-Of-File)	Line Input #1, T(n)		  'lê linha finalizada por CR+LF	If Len(T(n)) > MAXCHAR Or n > MAXLINE Then	   MsgBox "Texto deve possuir no máximo " & MAXLINE & " linhas " & vbCrLf & _			  "e no máximo " & MAXCHAR & " caracteres por linha.", vbCritical	   End					   'finaliza o programa	End If					   'fim da condição unidirecional	n = n + 1					'atualiza contador de strings (linhas) Loop							'fim do laço para leitura Close #1						'fecha o arquivo Exit Sub						'finaliza o procedimentoERROIO: 'Interrupção por falha de IO MensagemErroIO ("Leitura") 'chama o procedimento e retorna'Recomendo usar aqui a instrução Resume (define para onde reassumir) !!! End 'finaliza o programaEnd Sub 'LerArquivoTexto'*****************************************************************************'* Receber o nome de arquivo satisfazendo as condições: (1) nome deve conter *'* MAXTAM caracteres; (2) primeira letra do nome deve ser, P = texto Pleno,  *'* ou C = arquivo codificado (cifrado) ou D = arquivo decodificado (decifra- *'* do); (3) após a primeira letra, deve possuir xx2y, onde xx=Grupo, 2=Série *'* e y=Turma; (4) após xx2y deve possuir um nº seqüencial n (entre 1 e 9); e *'* (5) a extensão deve ser .TXT.											 *'*****************************************************************************Function NomeArquivoTexto(prefixo As String, titulo As String) As String'declarações locais neste escopo Dim nomearq As String	  'nome do arquivo fornecido via InputBox() Dim nomecorreto As Boolean 'condição do laço para receber nome correto'instruções - comandos e chamadas de procedimentos e/ou funções Do   nomearq = InputBox("Informe o nome do arquivo ou finalize a caixa diálogo ! " & _					   vbCrLf & vbCrLf & "Formato do nome = " & prefixo & "xx2yN.TXT", _					   "EDGxxSI2y: Arquivo para " & titulo)   NomeArquivoTexto = ""			  'inicializa retorno como string nula   If nomearq = "" Then Exit Function 'finaliza a função se nada informar   nomearq = UCase(nomearq)		   'converte caracteres para maiúsculos   nomecorreto = False				'inicializa condição do laço   'consistências encadeadas   If Len(nomearq) <> MAXTAM Then	  MsgBox "Nome deve possuir " & MAXTAM & " caracteres !", vbCritical   ElseIf Mid(nomearq, 1, 5) <> prefixo & "XX2Y" Then		  MsgBox "Nome não possui prefixo " & prefixo & "XX2Y !", vbCritical	  ElseIf Mid(nomearq, 6, 1) < "1" Or Mid(nomearq, 6, 1) > "9" Then			MsgBox "Nome não possui número seqüencial entre 1 e 9 !", vbCritical		 ElseIf Mid(nomearq, 7, 4) <> ".TXT" Then			   MsgBox "Nome não possui extensão .TXT !", vbCritical			Else			   NomeArquivoTexto = nomearq 'nome do arquivo correto			   nomecorreto = True		 'finalizar condição do laço			End If Loop While nomecorreto = FalseEnd Function 'NomeArquivoTexto'*****************************************************************************'* Mostra texto T com N strings (linhas) em caixa de diálogo via MsgBox.	 *'*****************************************************************************'Em VB não é possível receber argumento do tipo array por valor, ou seja, so-'mente por referência (ByRef por default)Sub MostraTexto(T() As String, n As Integer, titulo)'declarações locais neste escopo Dim i As Integer	'indexador para acesso a string Dim saida As String 'string de saída para caixa de diálogo'instruções - comandos e chamadas de procedimentos e/ou funções saida = ""							 'inicializa a string de saída For i = 1 To n - 1					 'indexador do texto varia de 0 até N-1	 saida = saida & T(i - 1) & vbCrLf  'concatena string i-ésima na saída Next								   'avança na próxima string do texto saida = saida & T(n - 1)			   'última linha sem vbcrlf MsgBox saida, , "EDGxxSI2y: " & titulo 'mostra saída na caixa de diálogoEnd Sub 'MostraTexto'****************************************************************************'* Procedimento principal realiza chamada das abstrações de ações.		  *'****************************************************************************Sub Main()'declarações locais neste escopo  Dim caminho As String		'caminho corrente incluindo a unidade Dim alfabeto As String	   'alfabeto original para qualquer texto Dim alfabetorand As String   'alfabeto pseudo-randômico Dim nomearquivo  As String   'nome do arquivo texto informado sem caminho Dim nomearquivoP As String   'caminho + arquivo texto PLENO (não normalizado) Dim nomearquivoN As String   'caminho + arquivo texto NORMALIZADO Dim nomearquivoC As String   'caminho + arquivo texto CODIFICADO Dim nomearquivoD As String   'caminho + arquivo texto DECODIFICADO Dim T1(MAXLINE) As String	'texto para codificar/decodificar Dim T2(MAXLINE) As String	'texto de entrada/saída da 1ª fase Dim T3(MAXLINE) As String	'texto de entrada/saída da 2ª fase Dim cifra As Integer		 'chave válida para codificar Dim n As Integer			 'quantidade de strings no texto Dim res As Integer		   'valor retornado por MsgBox 'instruções - comandos e chamadas de procedimentos e/ou funções  alfabeto = LETRAS & LETRAS_COM_ACENTOS & ALFANUMERICOS & Chr(34) & NUMERICOS Call GeraAlfabetoRand(alfabeto, alfabetorand) MsgBox "Alfabeto ORIGINAL" & vbCrLf & alfabeto & vbCrLf & vbCrLf & _		"Alfabeto PSEUDO-RANDÔMICO" & vbCrLf & vbCrLf & alfabetorand & vbCrLf & vbCrLf & _		"TAMANHO dos Alfabetos = " & Len(alfabeto), , "EDGxxSI2y: Alfabetos"  caminho = InputBox("Qual é o caminho completo, sem nome do arquivo ?", "EDGxxSI2y: Caminho") cifra = 0 'inicializa cifra para forçar codificar (encriptar)  Do 'laço para possibilitar testar o código para diversas instâncias   nomearquivo = NomeArquivoTexto("P", "Codificar") 'P = Pleno e sem informar o caminho   If nomearquivo <> "" Then	  nomearquivoP = caminho & "\" & nomearquivo 'concatena o caminho com o nome recebido	  Call LerArquivoTexto(nomearquivoP, T1, n)	  Call MostraTexto(T1, n, "Arquivo Pleno Original")	  Call NormalizaTexto(T1, n)	  Call MostraTexto(T1, n, "Texto Normalizado")	  nomearquivoN = caminho & "\N" & Mid(nomearquivo, 2, MAXTAM - 1) 'N = Normalizado	  Call GravarArquivoTexto(nomearquivoN, T1, n)	  MsgBox "Gravou o Texto Normalizado em: " & vbCrLf & vbCrLf & _			 nomearquivoN & vbCrLf & vbCrLf & "Pressione para Codificar o Texto.", _			 vbInformation, "EDGxxSI2y: Codificação"	  cifra = GetInt("EDGxxSi2y: Entrada da Cifra (chave) de César", _					 "Qual é a chave para codificar o texto ?", 1, MAXALF)	  Call CodificaComCifraCesar(T1, n, cifra, T2, alfabeto)	  Call MostraTexto(T2, n, "Texto Cifrado com a Chave " & cifra)	  Call CodificaComTrocaAlfabeto(T2, n, T3, alfabeto, alfabetorand)	  Call MostraTexto(T3, n, "Texto Cifrado com Alfabeto Pseudo-Randômico")	  nomearquivoC = caminho & "\C" & Mid(nomearquivo, 2, MAXTAM - 1) 'C = Codificado	  Call GravarArquivoTexto(nomearquivoC, T3, n)	  MsgBox "Gravou o Texto Codificado em: " & vbCrLf & vbCrLf & _			 nomearquivoC & vbCrLf & vbCrLf & _			 "Pressione para continuar", vbInformation, "EDGxxSI2y: Codificação "	  End If   If cifra <> 0 Then 'decodifica somente o mesmo arquivo codificado!	  res = MsgBox("Deseja decodificar (decifrar) ?", vbYesNo, "EDGxxSI2y: Decodificação")	  If res = vbYes Then		 cifra = MAXALF - cifra 'simétrico da chave (cifra)		 Call CodificaComTrocaAlfabeto(T3, n, T2, alfabetorand, alfabeto)		 Call MostraTexto(T2, n, "Texto Decifrado com Alfabeto Original")		 Call CodificaComCifraCesar(T2, n, cifra, T1, alfabeto)		 Call MostraTexto(T1, n, "Texto Decifrado com o Simétrico " & cifra)		 nomearquivoD = caminho & "\D" & Mid(nomearquivo, 2, MAXTAM - 1) 'D = Decodificado		 Call GravarArquivoTexto(nomearquivoD, T1, n)		 MsgBox "Gravou o Texto Decodificado em: " & vbCrLf & vbCrLf & _				 nomearquivoD & vbCrLf & vbCrLf & "Pressione para Comparar os Arquivos.", _				 vbInformation, "EDGxxSI2y: Decodificação"		 If ComparaArquivosTexto(nomearquivoN, nomearquivoD) Then			MsgBox "SUCESSO: Conteúdo dos arquivos são IGUAIS !" & vbCrLf & vbCrLf & _					nomearquivoN & vbCrLf & vbCrLf & nomearquivoD, vbInformation, _				   "EDGxxSI2y: Decodificação"		 Else			MsgBox "FRACASSO: Conteúdo dos arquivos são DIFERENTES !" & vbCrLf & vbCrLf & _					nomearquivoN & vbCrLf & vbCrLf & nomearquivoD, vbInformation, _				   "EDGxxSI2y: Decodificação"		 End If 'compara arquivos	  End If 'res = vbYes   End If 'cifra <> 0   res = MsgBox("Deseja Executar novamente ?", vbYesNo, "EDGxxSI2y: Criptografia") Loop While res <> vbNo 'condição do laço eternoEnd Sub 'Main

E esse é o Módulo Functions do Programa:

 

'declarações de constantes globais (visíveis em qualquer arquivo)  Global Const MAXALF = 138 'máximo de caracteres dos alfabetos'*****************************************************************************'* Normalizar o texto T com N strings, ou seja, retirar o excesso de espaços *'* em branco, no início, final e entre palavras de cada string do texto.	 *'*****************************************************************************Sub NormalizaTexto(ByRef T() As String, ByRef n As Integer)End Sub 'NormalizaTexto'*****************************************************************************'* Gerar o alfabeto (símbolos) Y de forma pseudo-randômica, através das abs- *'* trações (funções internas do VB) Randomize e Rnd, a partir de um dado al- *'* fabeto X, ou seja, permutar (trocar) os símbolos do alfabeto X para gerar *'* Y, sem preservar nenhuma posição original. O alfabeto X é um argumento de *'* entrada e o Y de saída.												   *'*****************************************************************************Sub GeraAlfabetoRand(alfainX As String, alfaoutY As String)End Sub 'GeraAlfabetoRand'*****************************************************************************'* Codificar o texto normalizado T1 com N strings, gerando o texto T2, subs- *'* tituindo os símbolos do alfabeto X utilizado em T1, por outro alfabeto Y, *'* onde os alfabetos são fornecidos como argumentos de entrada.			  *'*****************************************************************************Sub CodificaComTrocaAlfabeto(T1() As String, n As Integer, T2() As String, _							 alfainX As String, alfaoutY As String)End Sub 'CodificaComTrocaAlfabeto'*****************************************************************************'* Codificar o texto normalizado T1 com N strings, gerando o texto T2, des-  *'* locando os símbolos do alfabeto X utilizado em T1, pelo valor de uma dada *'* chave (cifra de César) utilizando Aritmética Modulo M, onde qualquer sím- *'* bolo sempre pertence ao mesmo alfabeto, podendo ocorrer deslocamento cir- *'* cular.																	*'*****************************************************************************Sub CodificaComCifraCesar(T1() As String, n As Integer, cifra As Integer, _						  T2() As String, alfaX As String)End Sub 'CodificaComCifraCesar' Observação: No lugar de Strings, pode ser utilizado LLS como um TAD!

Alguém poderia me ajudar a construir essas 4 funções?

Eu fiz o alfabeto aleatório, mas não consigui axar uma forma de evitar duplicidades...

Por isso não postei...

 

NormalizaTexto, GeraAlfabetoRand, CodificaComTrocaAlfabeto e CodificaComCifraCesar.

 

Atenciosamente,

César.

[ricsant 0]

do que exatamente você precisa?se for para trabalhar com criptografia, eu tenho um esquema pronto e tranquilo de fazer...se for isso mesmo... me passa teu email q envio...abs

[Cesar_Loko 0]

ricsant,

 

eu quero fazer um projeto na faculdade, mas eu odeio Visual Basic...

 

dai estou com dificuldades...

 

vou te mandar um programa modelo que eu recebi...

 

está upado no sendspace...

 

http://www.sendspace.com/file/6le2ku

 

meu email eh:

 

cesar_cifra@who.net

 

estou no aguardo..

 

^^

[ricsant 0]

te mandei um email...o meu é ricsant03@gmail.comabs