[Resolvido] Importação não aceita ', como tirar isso do listb

[Júnior Programador 0]

Olá amigos, uma boa tarde.

Novamente estou aqui, agora com uma dúvida, com a ajuda dos amigos, o listbox que estou desenvolvendo esta quase 100%, mas ainda acontece alguns bugs que estou vendo antes de levar para o cliente, pois nos colocamos no lugar do cliente, usando e abusando do software antes de levá-lo ao uso comercial.

 

O que acontece agora no meu listbox, na importação de todo o conteúdo de uma pasta, é que se tiver esse caracter ', ele da erro na importação, então vamos com duas perguntas.

 

Como tirar esse caracter do documento ao abrí-lo no listbox, e segundo, como substituir, palavras acentuadas por palavras que não usem acentos, exemplo ã por a, ó por o e assim por diante.

Abaixo segue o código de como esta o geral da importação de documentos para o banco de dados.

 

Só lembrando, se algum documento por exemplo for assim test'dd.doc ele da erro na importação por causa do '.

 

obrigado a todos

 

 

function RetiraExt(S: String): String;Var  Extensao: Integer;begin	Extensao := Pos('.', S);	Delete(S, Extensao, 4);	Result := S;end;function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam, lpData: LPARAM):  Integer; stdcall;var  Path: array[0..MAX_PATH] of Char;begin  case uMsg of	BFFM_INITIALIZED:	  begin		SendMessage(hwnd, BFFM_SETSELECTION, 1, lpData);		SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, lpData);	  end;	BFFM_SELCHANGED:	  begin		if SHGetPathFromIDList(Pointer(lParam), Path) then		  SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, Integer(@Path));	  end;  end;  Result := 0;end;function SelectDir(hOwner: THandle; const Caption, InitialDir: string;  const Root: WideString; ShowStatus: Boolean; out Directory: string): Boolean;var  BrowseInfo: TBrowseInfo;  Buffer: PChar;  RootItemIDList,	ItemIDList: PItemIDList;  ShellMalloc: IMalloc;  IDesktopFolder: IShellFolder;  Eaten, Flags: LongWord; //LongInt;//  Windows: Pointer;//^Integer;//  Path: string;begin  Result := False;  Directory := '';  Path := InitialDir;  if (Length(Path) > 0) and (Path[Length(Path)] = '\') then	Delete(Path, Length(Path), 1);  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then  begin	Buffer := ShellMalloc.Alloc(MAX_PATH);	try	  SHGetDesktopFolder(IDesktopFolder);	  IDesktopFolder.ParseDisplayName(hOwner, nil, PWideChar(Root), Eaten, RootItemIDList, Flags);	  with BrowseInfo do	  begin		hwndOwner := hOwner;		pidlRoot := RootItemIDList;		pszDisplayName := Buffer;		lpszTitle := PChar(Caption);		ulFlags := BIF_RETURNONLYFSDIRS;		if ShowStatus then		  ulFlags := ulFlags or BIF_STATUSTEXT;		lParam := Integer(PChar(Path));		lpfn := BrowseCallbackProc;		iImage := 0;	  end;	  // Make the browser dialog modal.	  Windows := DisableTaskWindows(hOwner);	  try		ItemIDList := ShBrowseForFolder(BrowseInfo);	  finally		EnableTaskWindows(Windows);	  end;	  Result := ItemIDList <> nil;	  if Result then	  begin		ShGetPathFromIDList(ItemIDList, Buffer);		ShellMalloc.Free(ItemIDList);		Directory := Buffer;	  end;	finally	  ShellMalloc.Free(Buffer);	end;  end;end;procedure TFImportar.btnprocurarClick(Sender: TObject);Var   SearchFile: TSearchRec;   FindResult: Integer;   FilesDir, DirSelect: String;Const   DefaultExt = '*.*';begin	 Listbox1.Clear;	 if SelectDir((Sender as TSpTBXButton).Parent.Handle, 'Procurar Diretório', FilesDir, '', False, DirSelect) then		FilesDir := DirSelect;	 if FilesDir = '' then		Exit;	 if FilesDir[Length(FilesDir)] <> '\'  then		FilesDir := FilesDir + '\';	 if FilesDir <> '' then		FindResult := FindFirst(FilesDir+DefaultExt, faArchive, SearchFile);		try		   While FindResult = 0 do		   begin				Application.ProcessMessages;				ListBox1.Items.Add(UpperCase((RetiraExt(SearchFile.Name))));				//ListBox1.Items.Add((RetiraExt(SearchFile.Name)));				FindResult := FindNext(SearchFile);		   end;		finally			  FindClose(SearchFile)		end;end;

[Hugo Slepicka 0]

Bom dia fera, belezera?

 

Tive muito problema com caracteres especiais quando fazia rotinas de importação...

 

Isso que ta acontecendo com você é um INJECTION...

 

você teria que dar um Replace no nome do arquivo e susbstituir o caracter ' pelo seu código ASCII ou então por nada para que ele suma caso use a 2ª opção ou então ele apareça nos textbox e labels que você possa vir a usar...

 

Por exemplo, nós tinhamos que gravar no banco o seguinte texto:

 

"Hoje no Japa's Bar teremos a banda do Zé Lezera"

 

Isso para o banco de dados dava pau, pois ele tentava no insert gravar assim:

 

Insert Into Eventos (Descricao) Values ('Hoje no Japa's Bar teremos a banda do Zé Lezera')

 

Note que ele quebrou a string da descrição em 2 e não fechou uma aspas...ai resolvemos isso passando o seguinte para o banco na instrução insert:

 

Insert Into Eventos (Descricao) Values ('Hoje no Japa' + #39 + 's Bar teremos a banda do Zé Lezera')

 

E ai ele tentava gravar na instrução o #39 e não convertia para o caracter ' sendo assim nas consultas o Delphi convertia e o nome vinha certo...

 

 

Com relação aos acentos e demais caracteres especiais existem funções para isso...

 

Link para um exemplo de função:

http://www.codigofonte.net/scripts-1226/re...rings-ou-campos

 

Abraço! http://forum.imasters.com.br/public/style_emoticons/default/thumbsup.gif

[Júnior Programador 0]

ola amigos problema resolvido, segue abaixo a funcao e como usar.

 

function RetChar(texto: string): string; stdcall; {Função que serve para identificar uma acento, cedilha ou trema em caracteres com letra maiúscula ou minúscula; recebe como variável uma string; retorna uma string.} const ComAcento = 'àâêôûãõáéíóúçüñÀÂÄÊÔÛÃÕÁÉÍÓÚÇÜ'''; SemAcento = 'aaeouaoaeioucuNAAAEOUAOAEIOUCU '; var x: Integer; begin for x := 1 to Length(texto) do if Pos(texto[x], ComAcento) <> 0 then texto[x] := SemAcento[Pos(texto[x], ComAcento)]; Result := texto; end; // da função RemoveAcentoCedilhaTrema

 

procedure TFImportar.btnprocurarClick(Sender: TObject); Var SearchFile: TSearchRec; FindResult: Integer; FilesDir, DirSelect: String; Const DefaultExt = '*.*'; begin Listbox1.Clear; if SelectDir((Sender as TSpTBXButton).Parent.Handle, 'Procurar Diretório', FilesDir, '', False, DirSelect) then FilesDir := DirSelect; if FilesDir = '' then Exit; if FilesDir[Length(FilesDir)] <> '\' then FilesDir := FilesDir + '\'; if FilesDir <> '' then FindResult := FindFirst(FilesDir+DefaultExt, faArchive, SearchFile); try While FindResult = 0 do begin Application.ProcessMessages; ListBox1.Items.Add(UpperCase((RetiraExt(RetChar(SearchFile.Name))))); //ListBox1.Items.Add((RetiraExt(SearchFile.Name))); FindResult := FindNext(SearchFile); end; finally FindClose(SearchFile) end; end;

valeu a todos http://forum.imasters.com.br/public/style_emoticons/default/dormindo.gif

[Júnior Programador 0]

informando aos parceiros de como funcionacréditos ao amigo adriano servitecfunction RetChar(texto: string): string; stdcall;{Função que serve para identificar uma acento, cedilha ou trema em caracteres com letramaiúscula ou minúscula; recebe como variável uma string; retorna uma string.}constComAcento = 'àâêôûãõáéíóúçüñÀÂÄÊÔÛÃÕÁÉÍÓÚÇÜ''';SemAcento = 'aaeouaoaeioucuNAAAEOUAOAEIOUCU ';varx: Integer;beginfor x := 1 to Length(texto) doif Pos(texto[x], ComAcento) <> 0 then texto[x] := SemAcento[Pos(texto[x], ComAcento)]; Result := texto;end; // da função RemoveAcentoCedilhaTremavaleu a atenção de todos